************************************************************ * Found at http://members.chello.at/manfred.mayer2 * ************************************************************ ************************************************************ * Dies ist ein Auszug meiner selbstgeschriebenen Programme * * auf dem SHARP Pocket-Computer PC-1403 * ************************************************************ Rechnen mit Uhrzeiten: ====================== Dieses Programm kann z.B. dazu verwendet werden um beim Überspielen einzelner Lieder einer CD die Länge auszurechnen. Eingabe für 4 min und 35 sec: "4.35". Eingabe für 2 Std 56 min 23 sec: "2.5623". Jede Eingabe wird dazuaddiert. Bei Eingabe von "0" wird die Summe ausgegeben. 10:"V":CLEAR :WAIT :PRINT "RECHNEN MIT UHRZEITEN" 20:INPUT "ZEIT: ";Z:IF Z=0 THEN 40 30:S=S+DEG Z:PAUSE STR$ (INT ((DMS S)*100)/100):GOTO 20 40:PRINT "SUMME: ";STR$ DMS S:END Wertetabelle: ============= Dieses Programm berechnet für die in Zeile 20 eingegebene Funktion eine Wertetabelle. In Zeile 50 können nichtdefinierte Werte für x (z.B.: x steht im Nenner) eingegeben werden. Das Programm wird mit "A" gestartet. Um nur einen Wert der Wertetabelle zu berechnen einfach im RUN-Modus den X-Wert eingeben und "Z" drücken. 10:"FUNKTION":REM ******** 20:Y=0.45/X 30:RETURN 40:"NENNER":REM ******** 50:IF X=0 THEN LET N$="NOTDEF":RETURN 60:N$="DEF":RETURN 70:REM ***************** 80:"A":WAIT :PRINT "WERTETABELLE" 90:INPUT "VON ";A:INPUT "BIS ";B:INPUT "STEP ";C 100:FOR X=A TO B STEP C 110:"Z":AREAD X:WAIT 120:GOSUB "NENNER" 130:IF N$="NOTDEF" THEN PRINT STR$ X;" ist nicht definiert":NEXT X 140:GOSUB "FUNKTION" 150:PRINT X,Y:NEXT X:END Quadtratische Gleichung: ======================== Dieses Programm löst eine quadratische Gleichung. Die POKE-Anweisungen in den Zeilen 20, 90 und 110 "zeichnen" die hochgestellte 2, äö und +- 10:"G":PRINT "Quadratische Gleichung" 20:WAIT 0:PRINT "a*X +b*X+c=0":POKE 12303,0,29,21,23,0:CALL 5268:WAIT 30:INPUT "a= ";A:INPUT "b= ";B:INPUT "c= ";C 40:IF B^2-4*A*C<0 THEN 80 50:X1=(-B+¹(B^2-4*A*C))/(2*A) 60:X2=(-B-¹(B^2-4*A*C))/(2*A) 70:PRINT "X1= ";STR$ X1:PRINT "X2= ";STR$ X2:END 80:XR=-B/(2*A):XI=¹(ABS (B^2-4*A*C)) 90:WAIT 0:PRINT "Immaginare Losung":POKE 12339,69,68,61:POKE 12393,69,68,69:CALL 5268:WAIT 100:PRINT "XR= ";STR$ XR 110:WAIT 0:PRINT "XI= ";STR$ XI;" j":POKE 12308,68,68,95,68,68:CALL 5268:WAIT :END Telefonverzeichnis: =================== Dieses Programm ist eine Telefondatenbank. Bei Eingabe eines Nachnamens (bzw. der ersten paar Buckstaben) sucht es die Daten nach diesem Namen ab. Neue Daten können ab Zeile 180 eingegeben werden, und zwar immer unterhalb des Anfangsbuchstabens des Nachnamens (REM FFFFFFF). Der POKE-Befehl in Zeile 120 "zeichnet" ein Telefon. Soll ein "RENUM" durchgeführt werden muß vorher die Zeile 60 auf "RESTORE 10" umgeschrieben werden und anschließend wieder auf "RESTORE A$". 10:" ":CLEAR :PAUSE "TELEFONVERZEICHNIS":WAIT 0:DIM TN$(0)*24 20:INPUT "NACHNAME: ";NA$ 30:IF NA$="LISTE" THEN 140 40:L=LEN (NA$):AN$=LEFT$ (NA$,1):A$=STR$ (ASC (AN$)-64) 50:IF ASC AN$<65 OR ASC AN$>90 OR L<1 THEN 120 60:RESTORE A$ 70:READ NN$,VN$,TN$(0) 80:IF LEFT$ (NN$,1)<>AN$ THEN PRINT "ENDE DER EINTRAGUNGEN!":CALL 5268:WAIT :END 90:IF LEFT$ (NN$,L)=NA$ THEN GOSUB 110 100:GOTO 70 110:PRINT NN$;" ";VN$:CALL 5268 120:PRINT " ";TN$(0):POKE 12288,70,103,83,73,69,67,93,85,93,67,69,73,83,103,70 130:CALL 5268:RETURN 140:RESTORE "1" 150:READ NN$,VN$,TN$(0) 160:IF NN$="ENDE" THEN PRINT "ENDE DER EINTRAGUNGEN!":CALL 5268:WAIT :END 170:GOSUB 110:GOTO 150 180:"1":REM AAAAAAAAAAAAAA 190:DATA "AUSKUNFT","","1611" 200:"2":REM BBBBBBBBBBBBBBB 210:"3":REM CCCCCCCCCCCCC 220:"4":REM DDDDDDDDDDDDDDD 230:"5":REM EEEEEEEEEEEEE 240:"6":REM FFFFFFFFFFFFF 250:"7":REM GGGGGGGGGGGGG 260:DATA "GEMEINDE","Katzelsdorf","78200" 270:"8":REM HHHHHHHHHHHHHH 280:DATA "HTL","Wr.Neustadt","27871 bis 27874" 290:"9":REM IIIIIIIIIIIII 300:"10":REM JJJJJJJJJJJJJ 310:"11":REM KKKKKKKKKKKK 320:"12":REM LLLLLLLLLLLLL 330:"13":REM MMMMMMMMMMMM 340:DATA "MAC","DONALDS","29835" 350:"14":REM NNNNNNNNNNNN 360:"15":REM OOOOOOOOOOO 370:DATA "ORF","Kundendienst","0222/8773671" 380:"16":REM PPPPPPPPPPPP 390:DATA "POST","P.S.K.","78280 (78260)" 400:"17":REM QQQQQQQQQQQQ 410:"18":REM RRRRRRRRRRRR 420:"19":REM SSSSSSSSSSSS 430:DATA "STOEHR","Elektronik","27454-31" 440:"20":REM TTTTTTTTTTTT 450:"21":REM UUUUUUUUUUUU 460:"22":REM VVVVVVVVVVVV 470:"23":REM WWWWWWWWWWWW 480:"24":REM XXXXXXXXXXX 490:"25":REM YYYYYYYYYYYY 500:"26":REM ZZZZZZZZZZZZ 510:DATA "ZEITANSAGE","","1503" 520:DATA "ENDE","DER","EINTRAGUNGEN" Zeitschaltuhr: ============== Mit diesem Programm und einer kleinen Elektronikschaltung ist es möglich ein beliebiges Gerät (z.B. Lampe, Radio) zeitgesteuert Ein- und Auszuschalten. Die Uhr hat leider nur eine Genauigkeit von +- 2 min in 24 Stunden (siehe FOR-NEXT-Schleife in Zeile 200). 10:"X":PAUSE "Steuerungsprogramm":CLEAR:WAIT 0 20:INPUT "Wieviele Schaltzeiten : ";MAX 30:DIM HX(MAX):DIM MX(MAX):DIM XX(MAX) 40:FOR I=0 TO MAX:HX(I)=30:XX(I)=0:NEXT I 50:FOR I=0 TO MAX 60:PAUSE I+1;" SCHALT-Zeit eingeben!":INPUT "HH.MM ";SC$ 70:SZ$=SC$:HX(I)=VAL (MID$ (SZ$,1,2)) 80:MX(I)=VAL (MID$ (SZ$,4,2))-1 90:INPUT "EIN oder AUS ? ";E$ 100:IF E$="EIN" THEN LET XX(I)=255 110:NEXT I 120:PAUSE "AKTUELLE Zeit eingeben !" 130:INPUT "HH.MM.SS ";AZ$ 140:H=VAL (MID$ (AZ$,1,2)) 150:M=VAL (MID$ (AZ$,4,2)) 160:S=VAL (MID$ (AZ$,7,2))+1 170:FOR H=H TO 23 180:FOR M=M TO 59 190:FOR S=S TO 59 200:FOR J=1 TO 135:NEXT J 210:PRINT H;M;STR$ S:CALL 1208 220:NEXT S:S=1 230:FOR I=0 TO MAX 240:IF H=HX(I) AND M=MX(I) THEN POKE 14848,XX(I) 250:NEXT I 260:NEXT M:M=0:NEXT H:H=0:GOTO 170 Abschaltautomatik: ================== Mit diesem Programm und einer kleinen Elektronikschaltung ist es möglich ein beliebiges Gerät (z.B. Lampe, Radio) verzögert Auszuschalten. Die Uhr hat leider nur eine Genauigkeit von +- 2 min in 24 Stunden (siehe FOR-NEXT-Schleife in Zeile 60). 10:"C":PAUSE "Abschalt-Automatik":WAIT 0 20:INPUT "Minuten: ";M 30:POKE 14848,255 40:FOR M=M-1 TO 0 STEP -1 50:FOR S=59 TO 0 STEP -1 60:FOR I=1 TO 139:NEXT I 70:PRINT M;STR$ S:CALL 1208:NEXT S:NEXT M 80 POKE 14848,0 80:WAIT :PRINT "Auto-Power-Off in 11 min":END Programm auf Schnittstelle ausgeben: ==================================== Mit diesem Programm, einem Spezialkabel und einem PC-Programm ist es möglich, das Programm des PC-1403 auf den PC zu übertragen. 10:",":WAIT :CLEAR :PRINT "KOPIEREN AUF PC" 20:B=41009:E=47885-MEM 30:PRINT "Endadr. -";STR$ (E);"- fuer PC !" 40:INPUT "STARTEN (J/N) ? ";S$:IF S$="N" THEN END 50:FOR I=B TO E 60:A=(PEEK (I)AND 240)/16 70:"WERT":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,97,4,95,88,82,55:CALL 63424 80:"AUS":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,88,82,55:CALL 63424 90:A=PEEK (I)AND 15 100:"WERT":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,97,4,95,88,82,55:CALL 63424 110:"AUS":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,88,82,55:CALL 63424 120:NEXT I:PRINT "ENDE DER UEBERTRAGUNG" 130:A=0 140:"AUS":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,88,82,55:CALL 63424 150:"WERT":POKE 63424,2,A,18,94,88,16,58,0,82,96,0,95,88,82,55:CALL 63424 160:END Lauflicht: ========== Bei Ausführen dieses Programmes sieht man am Display ein Lauflicht. 10:WAIT 0:PRINT "DEMO !!!":CALL 1208:WAIT 20:FOR I=1 TO 1000 30:POKE 12288+60,64,0:GOSUB 120 40:POKE 12288+60,0,64:GOSUB 120 50:POKE 12288+60,0,32:GOSUB 120 60:POKE 12288+60,0,16:GOSUB 120 70:POKE 12288+60,32,0:GOSUB 120 80:POKE 12288+60,0,16:GOSUB 120 90:POKE 12288+60,0,32:GOSUB 120 100:POKE 12288+60,0,64:GOSUB 120 110:NEXT I 120:IF INKEY$="" THEN RETURN 130:END Zahlenraten: ============ Ein Spiel, bei dem sich der Computer eine Zahl ausdenkt, die der Spieler erraten muß. Wird bei Spieler kein Name eingegeben spielt der Computer gegen sich selber. 10:CLEAR:WAIT 50:PRINT "ZAHLENRATEN" 20:INPUT "VON 1 BIS ";C:RANDOM 30:S$="":INPUT "SPIELER: ";S$ 40:PRINT "VON 1 BIS ";STR$ C 50:Z=RND C:O=C:U=0:V=0:X$="" 60:V=V+1:IF S$="" THEN 110 70:INPUT "ZAHL: ";A:CALL 1208 80:IF AZ THEN PRINT "ZU GROSS !!!":CALL 1208:X$="G":GOTO 60 100:PRINT "GRATULIERE ";S$:PRINT "MIT ";STR$ V;" VERSUCHEN":CALL 5268:GOTO 40 110:IF X$="K" THEN LET U=A 120:IF X$="G" THEN LET O=A 130:A=INT(U+((O-U)/2)):PRINT "ZAHL: ";A:CALL 1208:GOTO 80 Demo-Scroller: ============== Dieses Programm läßt einen Text durch das Display laufen. Werden mehr oder weniger als 4 Textblöcke zu je 20 Buchstaben gebraucht muß der Wert für Z in Zeile 10 abgeändert werden. 10:CLEAR:Z=4:DIM X$(Z)*20:RESTORE 70 20:FOR I=1 TO Z:READ X$(I):NEXT I 30:WAIT 0:FOR A=1 TO Z-1 40:FOR I=20 TO 1 STEP -1 50:PRINT RIGHT$(X$(A),I);LEFT$(X$(A+1),20-I):CALL 1208 60:NEXT I:NEXT A:END 70:DATA " ","Scrolltext mit 20 Bu" 80:DATA "chstaben hier eitrag","en " Glücksrad: ========== Bei diesem Spiel muß ein zweiter Spieler ein Wort eingeben und der Andere muß es durch probieren von Buchstaben erraten. Beim Raten einfach den Buchstaben antippen. Wenn man das ganze Wort weiß "=" drücken und eintippen. 10:WAIT:PRINT "* * * GLUECKSRAD * * *":CLEAR:DIM X$(21)*1:DIM B$(21)*1:DIM Y$(1)*21:S$=chr$(249) 20:INPUT "WORT: ";Y$(1):L=LEN Y$(1) 30:IF L>20 THEN PRINT "Maximal 20 Buchstaben !!":GOTO 20 40:WAIT 0:FOR I=1 TO L 50:B$(I)=S$:X$(I)=MID$ (Y$(1),I,1) 60:IF ((X$(I)<"A") OR (X$(I)>"Z")) THEN LET B$(I)=X$(I):F=F+1 70:NEXT I:SP$=LEFT$ (" ",21-L):GOTO 130 80:CALL 5268:R$=INKEY$:IF R$="" THEN 80 90:IF R$="=" THEN 120 100:FOR I=1 TO L:IF ((R$=X$(I)) AND (X$(I)<>B$(I))) THEN LET B$(I)=X$(I):F=F+1 110:NEXT I:C=C+1:GOTO 130 120:C=C+1:INPUT "LOESUNG: ";Y$(0):IF Y$(0)=Y$(1) THEN 160 130:Y$(0)="":FOR I=1 TO L:Y$(0)=Y$(0)+B$(I):NEXT I 140:PRINT Y$(0);SP$;STR$ C 150:IF F9)) THEN LET LE=0 100:LE=LE+1:PRINT "ALL RIGHT... LEVEL ";STR$ LE:CALL 1208 110:FOR I=1 TO 90:X(I)=0:NEXT I 120:A$=STR$ LE:IF LE>UL THEN 150 130:RESTORE A$:REM ************* 140:READ LA,DA,IA:FOR I=1 TO DA:READ PO,X(PO):NEXT I:GOTO 210 150:LA=20+RND (70):YN=RND (5):XN=3:S=-1:X(XN)=S*(2^YN):IA=2^(YN+S) 160:YA=YN:YN=RND (5):S=(-1)*S 170:RN=UL+9-LE:IF RN<0 THEN LET RN=0 180:AB=ABS ((-S+YA)-(S+YN)):IF AB=0 THEN LET AB=1 190:XN=XN+AB+ INT (RND (RN)):IF XN>=LA THEN 210 200:X(XN)=S*(2^YN):GOTO 160 210:PRINT "":CALL 1208:IC=IA 220:FOR I=1 TO LA 230:POKE P(I),ABS X(I):NEXT I 240:FOR I=1 TO 20:POKE P(1),0:POKE P(LA+1),127:CALL 1208:POKE P(1),IC:NEXT I:CALL 1200:CALL 1208 250:FOR I=1 TO LA 260:POKE P(I-1),ABS X(I-1):POKE P(I),IC+ABS X(I) 270:IF ((X(I)<0) AND (IC>=ABS X(I))) THEN 340 280:IF ((X(I)>0) AND (IC<=ABS X(I))) THEN 340 290:T=0:FOR W=1 TO WA:A$=INKEY$:IF ((A$<>"") AND (T=0)) THEN GOSUB 310 300:NEXT W:NEXT I:CALL 1200:GOTO 100 310:IF ((A$="8") AND (IC>1)) THEN LET IC=IC/2:T=1:RETURN 320:IF ((A$="2") AND (IC<64)) THEN LET IC=IC*2:T=1:RETURN 330:RETURN 340:CALL 7008:PRINT "TOT! ";STR$ CR; " CREDITS LEFT ...":CALL 5268 350:IF CR=0 THEN PRINT "SORRY, 0 CREDITS LEFT...":CALL 5268:END 360:PRINT "TRY ROUND ";STR$ LE;" AGAIN...":CALL 5268:CR=CR-1:I=1000:NEXT I:GOTO 210 370:"1":DATA 45,9,32,3,16,10,-4,15,8,21,-2,25,2,29,-2,34,8,37,-8,43,32 380:"2":DATA 53,12,2,3,-8,7,8,13,-2,17,4,22,-4,29,32,35,-16,36,4,40,-4,43,4,47,-2 390:DATA 50,2 400:"3":DATA 50,11,2,-4,7,4,9,-4,11,4,16,-2,24,32,30,-16,35,32,41,-2,45,4,46,-8 410:"4":DATA 27,10,2,2,-4,6,8,8,-8,10,8,16,-2,17,1,18,-2,19,1,21,-2,25,4 420:"5":DATA 90,17,32,3,16,10,-4,15,8,21,-2,25,2,29,-2,34,8,37,-8,43,32 430:DATA 53,-8,57,8,63,-2,67,4,72,-4,79,32,85,-16,86,4 Speedy chars: ============= Bei diesem Spiel muß man als Strich vorbeifahrenden Zeichen ausweichen. Steuerung mit "8" und "2". Sollen neue Zeichen hinzugefügt werden muß man erst den Wert für Z in Zeile 10 erhöhen. Das neue Zeichen wird einfach bei DATA ganz unten angefügt. Zuerst den ASCII-Code des Zeichens und dann wo man durchfahren kann (z.B. Das Zeichen "." man kann oben und mittig durchfahren DATA 46,"OM ") 10:CLEAR:ML=7:Z=20:K=50:DIM X$(Z):DIM Y$(K):DIM AN$(3)*32:DIM P$(7) 20:POKE 65302,128:IC=3:P$(2)=CHR$(126):P$(3)="-":P$(4)=CHR$(95):WAIT 0:RANDOM:RESTORE 270 30:PRINT "SPEEDY CHARS":CALL 5268:Y$(0)=" OMU":AN$(3)=" " 40:FOR I=1 TO Z:READ A,B$:X$(I)=CHR$(A)+B$:NEXT I 50:L=L+1:PRINT "ALL RIGHT... LEVEL ";STR$ L:CALL 1208 60:WA=2*ML-2*L:SP=ML+1-L:AN$(1)="":AN$(2)="" 70:FOR I=1 TO K:XX=1+INT ((I-1)/25) 80:IF ((I/SP)=INT (I/SP)) THEN LET Y$(I)=X$(RND Z):GOTO 110 90:Y$(I)=" OMU" 100:AN$(XX)=AN$(XX)+LEFT$(Y$(I),1):NEXT I 110:CALL 1200:CALL 1208 120:FOR I=1 TO K 130:IF I>25 THEN 150 140:PRINT P$(IC);RIGHT$(AN$(1),26-I);AN$(2):GOTO 160 150:PRINT P$(IC);RIGHT$(AN$(2),51-I) 160:CALL 1208:IF MID$(Y$(I-1),IC,1)=" " THEN 230 170:FOR J=1 TO WA:A$=INKEY$:IF A$<>"" THEN GOSUB 200 180:NEXT J:NEXT I:IF L=ML THEN 260 190:GOTO 50 200:IF A$="8" AND IC<>2 THEN LET IC=IC-1:GOTO 220 210:IF A$="2" AND IC<>4 THEN LET IC=IC+1 220:J=1000:RETURN 230:FOR J=1 TO 10:POKE 12288,85,42,85,42,85:CALL 7008:CALL 7008:CALL 1208 240:POKE 12288,42,85,42,85,42:CALL 7008:CALL 7008:CALL 1208:NEXT J 250:PRINT "TOT...":CALL 5268:END 260:PRINT "WAHNSINN ! ";STR$(L);" LEVELS !!!":CALL 5268:END 270:DATA 34," MU",39," U",96," U",126," MU",162," MU",223," MU" 280:DATA 124," M ",250," M " 290:DATA 42,"O U",46,"OM ",97,"O ",170,"OM ",180,"O ",186,"O " 300:DATA 204,"O ",208,"O U",214,"O ",221,"O ",246,"O ",101,"O " (c) MM 1989-1999