Archived
1
0
This repository has been archived on 2025-03-31. You can view files and clone it, but cannot push or open issues or pull requests.
powerbasic/pingpong.bas
2013-07-15 23:19:32 +02:00

86 lines
2.5 KiB
QBasic
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

cls:screen 12
'open "O",#1,"KLATSCH.RAW"
dim check(640)
FOR SbPort = &H210 to &H280 STEP &H10
OUT SbPort + &H6, 1
FOR a = 1 to 10:next
OUT SbPort + &H6, 0
FOR a = 1 to 100
IF INP(SbPort + &HA) = &HAA THEN GOTO SbFound
NEXT
NEXT
PRINT "kein SoundBlaster => Ende..."
END
SbFound:
locate 1,1
color 10:print"SoundBlaster an Adresse ";hex$(SbPort);"h gefunden."
color 15:print
DO
OUT SbPort + &HC, &H20
DO:LOOP UNTIL INP(SbPort + &HE) AND 128
'locate 2,1:print Wert;"/";inp(sbport+&HA)
'gosub ShowLEV
if minus=0 then strecke=strecke+1
if minus=1 then strecke=strecke-1
if strecke>639 then minus=1
if strecke<1 then minus=0
value=(256-125+(inp(sbport+&HA)-125))/256*480
'locate 2,1:print value;
pset (strecke,check(strecke)),0
if value>190 or value<290 then col=10
if (value>155 and value<190) or (value >290 and value <325) then col=14
if value<155 or value>325 then col=12
' col=15 'ÚÄ y1
if minus=0 then ls=strecke+1 else ls=strecke-1
line (ls,0)-(ls,480),0 'Wer mit der MAX-Anzeige arbeitet sollte y1 auf 13 setzen
' pset (veryolds,veryoldv),8
pset (olds,oldv),7 'Diese Zeile sollte ungeREMt bleiben
' if maxvalue<>oldmax then locate 1,1:color 15:print "Max:";maxvalue
' oldmax=maxvalue 'alles mit einem 'max' in der Variablen geh”rt zur Maxerkennung
if strecke=1 then pset(0,240),0
line -(strecke,value),col 'Wer aus 'line -' ein 'pset ' macht, und alle anderen REMs entfernt, hat auch einen coolen FX
' maxvalue=max(Maxvalue,abs(value))
' veryolds=olds
' veryoldv=oldv
olds=strecke 'Wenn man die beiden oldx's REMt erh„lt man einen recht
oldv=value 'lustigen Effekt!!!
delay del
check(strecke)=value
'print#1,chr$(inp(sbport+&HA));
a$=inkey$
if a$="+" then del=del+.01
if a$="-" then del=del-.01:if del<0 then del=0
if a$="*" then del=del+.1
if a$="/" then del=del-.1:if del<0 then del=0
if a$="0" then del=0
if a$="1" then del=1
LOOP UNTIL a$=chr$(27)
Goto Ende
ShowLEV:
y=3
Zeichen=176
Einheit=256/80
Wert=inp(sbport+&HA)
Einheiten=round(Wert/Einheit,0)
for x=1 to 80
locate y,x:if x<=Einheiten then
if x>=0 and x<=45 then color 10
if x>45 and x<=70 then color 14
if x>70 and x<=80 then color 12
else
if x>=0 and x<=45 then color 2
if x>45 and x<=70 then color 6
if x>70 and x<=80 then color 4
end if
print chr$(Zeichen);
locate y+1,x
print chr$(Zeichen);
next x
return
Ende:
screen 0:width 80
print"Programm beendet."