100 '*********************************
110 '******    S C R E E N Y    ******
120 '******  by J. Steingr{ber  ******
130 '******   & U. Baumgarten   ******
140 '******     Im Mai 1987     ******
150 '*********************************
160 '
170 GOSUB 50050
180 PRINT CHR$(27)+"E"+CHR$(27)+"H"+CHR$(27)+"f"
190 PRINT:PRINT:PRINT
200 PRINT TAB(40);"S C R E E N Y"
210 PRINT:PRINT:PRINT
220 PRINT TAB(35);"Demo 1: Analog/Digital-Uhr"
230 PRINT
240 PRINT TAB(35);"Demo 2: Apfelm{nnchen"
250 PRINT:PRINT:PRINT
260 PRINT TAB(19);"Hinweis: Beide Demos k|nnen mit Tastendruck beendet werden."
270 PRINT:PRINT:PRINT
280 t$="Bitte w{hlen Sie <1> oder <2> !"
290 FOR i=1 TO LEN(t$):PRINT TAB(30+i);MID$(t$,i,1);
300 FOR w=1 TO 45:NEXT
310 a$=INKEY$:IF a$="1" OR a$="2" THEN 370
320 NEXT i:PRINT CHR$(13);
330 FOR i=1 TO LEN(t$):PRINT TAB(30+i);" ";
340 FOR w=1 TO 45:NEXT
350 a$=INKEY$:IF a$="1" OR a$="2" THEN 370
360 NEXT i:PRINT CHR$(13);:GOTO 290
370 ON VAL(a$) GOSUB 1000,2000
380 GOTO 180
1000 '
1010 '*********** D E M O 1
1020 '
1030 '
1040 '**** Initialisierung
1050 '
1060 DEF FNloc$(z,s)=CHR$(27)+"Y"+CHR$(z+32)+CHR$(s+32)
1070 pi=3.141592654#
1080 cls$=CHR$(27)+"E"+CHR$(27)+"H"
1090 con$=CHR$(27)+"e":coff$=CHR$(27)+"f"
1100 ston$=CHR$(27)+"1":stoff$=CHR$(27)+"0"
1110 '
1120 '**** ]berschrift und Zeiteingabe
1130 '
1140 PRINT cls$;FNloc$(5,0);
1150 PRINT TAB(26);"A N A L O G / D I G I T A L-U H R"
1160 PRINT FNloc$(10,33);">>>>> Zeiteingabe <<<<<"
1170 PRINT
1180 PRINT TAB(40);:INPUT"Stunden: ",hh
1190 PRINT TAB(40);:INPUT"Minuten: ",mm     :ss = 0
1200 PRINT cls$;coff$;
1210 '
1220 '**** Adressen f}r Stunden, Minuten, Sekunden
1230 '
1240 h=64502!:m=h+1:s=m+1
1250 '
1260 '**** Umrechnung in Hex-Zahlen
1270 '
1280 hh=hh/10:hi=INT(hh):lo=10*(hh-hi):hh=16*hi+lo
1290 mm=mm/10:hi=INT(mm):lo=10*(mm-hi):mm=16*hi+lo
1300 ss=ss/10:hi=INT(ss):lo=10*(ss-hi):ss=l6*hi+lo
1310 '
1320 '**** Kreis zeichnen
1330 '
1340 z%=128:s%=610:CALL point2(z%,s%):m%=1       : 'Anfangspunkt
1350 FOR i=pi/60 TO 2*pi+pi/60 STEP pi/60
1360 z%=128-0.46*250*SIN(i):s%=360+250*COS(i):CALL draw(z%,s%,m%)
1370 CALL point2(z%,s%)
1380 NEXT
1390 z%=128:s%=610:CALL point2(z%,s%):s%=600:CALL draw(z%,s%,m%)
1400 z%=128:s%=110:CALL point2(z%,s%):s%=120:CALL draw(z%,s%,m%)
1410 z%=128-0.46*250:s%=360:CALL point2(z%,s%):z%=128-0.46*240:CALL draw(z%,s%,m%)
1420 z%=128+0.46*250:s%=360:CALL point2(z%,s%):z%=128+0.46*240:CALL draw(z%,s%,m%)
1430 '
1440 '**** Text f}r Statuszeile
1450 '
1460 PRINT ston$;:t$="                              Zum Start eine Taste dr}cken !                              "
1470 z%=248:FOR i=1 TO LEN(t$):s% =8*(i-1):c%=ASC(MID$(t$,i,1)):CALL setchar(z%,s%,c%):NEXT
1480 '
1490 '**** Zeit setzen und Uhrstart
1500 '
1510 z2%=128:m%=2 : POKE s,0:POKE m,mm:POKE h,hh
1520 WHILE INKEY$="":POKE s,0:WEND:PRINT stoff$;
1530 '
1540 '**** Zeiger zeichnen
1550 '
1560 a=pi/2-VAL(HEX$(hh))*pi/6-VAL(HEX$(mm))*pi/360
1570 s2%=360:CALL point2(z2%,s2%):s%=360+150*COS(a):z%=128-0.46*150*SIN(a):CALL draw(z%,s%,m%)
1580 b=pi/2-VAL(HEX$(mm))*pi/30
1590 s2%=361:CALL point2(z2%,s2%):s%=361+210*COS(b):z%=128-0.46*210*SIN(b):CALL draw(z%,s%,m%)
1600 c=pi/2-VAL(HEX$(ss))*pi/30
1610 s2%=359:CALL point2(z2%,s2%):s%=359+220*COS(c):z%=128-0.46*220*SIN(c):CALL draw(z%,s%,m%)
1620 s3%=359+230*COS(c):z3%=128-0.46*230*SIN(c):CALL setpoint(z3%,s3%,m%)
1630 '
1640 '**** Zeitanzeige digital
1650 '
1660 PRINT FNloc$(31,41);HEX$(PEEK(h),2)+":"+HEX$(PEEK(m),2)+":"+HEX$(PEEK(s),2)+CHR$(27)+"H"
1670 WHILE PEEK(s)=ss:WEND:ss=PEEK(s)     :'eine Sekunde warten
1680 IF INKEY$<>"" THEN RETURN       :'R}ckkehr zum Men}
1690 '
1700 '**** Zeiger l|schen
1710 '
1720 CALL draw(z%,s%,m%)
1730 IF PEEK(m)=mm THEN 1600
1740 mm=PEEK(m)
1750 s2%=361:CALL point2(z2%,s2%):s%=361+210*COS(b):z%=128-0.46*210*SIN(b):CALL draw(z%,s%,m%)
1760 s2%=360:CALL point2(z2%,s2%):s%=360+150*COS(a):z%=128-0.46*150*SIN(a):CALL draw(z%,s%,m%)
1770 hh=PEEK(h)
1780 GOTO 1560
2000 '
2010 '
2020 '
2030 '********** D E M O 2
2040 '
2050 '
2060 '**** Zeichen definieren
2070 '
2080 mc=&HF400: RESTORE 2100
2090 FOR i=0 TO 52: READ p: POKE mc+i,p: NEXT i
2100 DATA 1,9,244,205,90,252,233,0,201,33,21,244,1,32,0,17,0,184,237,176,201
2110 DATA 160,0,0,0,0,0,0,0,224,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,64,0,0,0,0,0,0,0
2120 CALL mc
2130 '
2140 '**** Grenzen festlegen
2150 '
2160 ur=-1    :'unterer Rand
2170 o=1      :'oberer Rand
2180 lr=-0.7  :'linker Rand
2190 rr=2.1   :'rechter Rand
2200 n=30     :'Iterationstiefe
2210 '
2220 '**** Apfelm{nnchen zeichnen
2230 '
2240 PRINT CHR$(27)+"0"+CHR$(27)+"E"+CHR$(27)+"f"
2250 FOR s=0 TO 237:FOR z=247 TO 0 STEP -1
2260 x0=lr+s*(rr-lr)/237:y0=ur+z*(o-ur)/247
2270 m=0:x=x0:y=y0
2280 m=m+1:xn=x*x-y*y-x0:yn=2*x*y-y0:x=xn:y=yn:IF m<n AND x*x+y*y<8 THEN 2280
2290 pc%=m MOD 4
2300 pz%=247-z:ps%=s*3:CALL setchar(pz%,ps%,pc%)
2310 IF INKEY$<>"" THEN RETURN
2320 NEXT:NEXT:PRINT CHR$(7)
2330 WHILE INKEY$="":WEND:RETURN
50000 '
50010 '************* L A D E R O U T I N E
50020 '
50030 '**** SETCHAR-DATAs
50040 '
50050 MEMORY &HEFFF:RESTORE 50070
50060 FOR adr=&HF000 TO &HF0B9:READ a$:POKE adr,VAL("&H"+a$):NEXT
50070 DATA 7E,EB,5E,23,56,60,69,4E
50080 DATA FE,F9,38,02,D6,F8,32,B1
50090 DATA F0,7A,FE,02,38,0E,28,04
50100 DATA 16,00,18,08,7B,FE,C9,38
50110 DATA 03,D6,C8,5F,43,7B,E6,F8
50120 DATA 5F,ED,53,B2,F0,79,32,B4
50130 DATA F0,78,E6,07,32,B5,F0,47
50140 DATA 3E,FF,28,04,CB,3F,10,FC
50150 DATA 6F,2F,67,22,B6,F0,69,26
50160 DATA 00,29,29,29,7C,C6,B8,67
50170 DATA 22,B8,F0,01,5C,F0,CD,5A
50180 DATA FC,E9,00,C9,06,08,C5,21
50190 DATA B1,F0,5E,7E,34,E6,07,4F
50200 DATA 16,00,EB,29,7C,C6,B6,67
50210 DATA 5E,23,56,EB,29,06,00,B7
50220 DATA ED,42,E5,DD,E1,2A,B8,F0
50230 DATA ED,5B,B2,F0,DD,19,56,1E
50240 DATA 00,3A,B5,F0,47,B7,28,06
50250 DATA CB,3A,CB,1B,10,FA,DD,7E
50260 DATA 00,2A,B6,F0,A4,B2,DD,77
50270 DATA 00,DD,7E,08,A5,B3,DD,77
50280 DATA 08,21,B8,F0,34,C1,10,AE
50290 DATA C9,00,00,00,00,00,00,00
50300 DATA 00,00
51000 '
51010 '**** SETPOINT-DATAs
51020 '
51030 FOR adr=&HF0BA TO &HF161:READ a$:POKE adr,VAL("&H"+a$):NEXT
51040 DATA 7E,EB,5E,23,56,60,69,4E
51050 DATA 47,ED,43,5B,F1,ED,53,5D
51060 DATA F1,01,D4,F0,CD,5A,FC,E9
51070 DATA 00,C9,ED,4B,5B,F1,ED,5B
51080 DATA 5D,F1,78,32,5C,F1,7A,FE
51090 DATA 02,38,0E,28,04,16,00,18
51100 DATA 08,7B,FE,D0,38,03,D6,CF
51110 DATA 5F,43,7B,E6,F8,5F,ED,53
51120 DATA 5D,F1,79,E6,03,32,5B,F1
51130 DATA 78,E6,07,32,5F,F1,47,3E
51140 DATA 80,28,04,CB,3F,10,FC,6F
51150 DATA 2F,67,22,60,F1,21,5C,F1
51160 DATA 5E,7E,E6,07,4F,16,00,EB
51170 DATA 29,7C,C6,B6,67,5E,23,56
51180 DATA EB,29,06,00,B7,ED,42,E5
51190 DATA DD,E1,ED,5B,5D,F1,DD,19
51200 DATA 3A,5B,F1,DD,46,00,2A,60
51210 DATA F1,B7,20,06,78,A4,DD,77
51220 DATA 00,C9,1F,30,06,78,B5,DD
51230 DATA 77,00,C9,78,A5,28,F6,18
51240 DATA EB,00,00,00,00,00,00,00
52000 '
52010 '**** DRAW-DATAs
52020 '
52030 FOR adr=&HF162 TO &HF255:READ a$:POKE adr,VAL("&H"+a$):NEXT
52040 DATA 7E,EB,5E,23,56,60,69,4E
52050 DATA 47,3A,46,F2,2A,47,F2,32
52060 DATA 46,F2,ED,43,42,F2,ED,53
52070 DATA 44,F2,22,47,F2,90,06,01
52080 DATA 20,01,05,30,04,05,05,2F
52090 DATA 3C,4F,78,32,49,F2,AF,47
52100 DATA ED,52,11,01,00,20,01,1B
52110 DATA 30,09,1B,1B,7C,2F,67,7D
52120 DATA 2F,6F,23,ED,53,4B,F2,E5
52130 DATA D1,E5,AF,ED,42,7C,32,4D
52140 DATA F2,17,E1,30,06,D5,C5,C5
52150 DATA E1,D1,C1,22,4E,F2,CB,3C
52160 DATA CB,1D,22,50,F2,ED,43,52
52170 DATA F2,ED,53,54,F2,01,D8,F1
52180 DATA CD,5A,FC,E9,00,C9,ED,4B
52190 DATA 42,F2,ED,5B,44,F2,CD,DC
52200 DATA F0,3A,4D,F2,17,38,0D,2A
52210 DATA 44,F2,ED,4B,4B,F2,09,22
52220 DATA 44,F2,18,0B,ED,4B,42,F2
52230 DATA 3A,49,F2,80,32,43,F2,2A
52240 DATA 50,F2,ED,4B,52,F2,AF,ED
52250 DATA 42,22,50,F2,30,26,ED,4B
52260 DATA 54,F2,09,22,50,F2,3A,4D
52270 DATA F2,17,30,0D,2A,44,F2,ED
52280 DATA 4B,4B,F2,09,22,44,F2,18
52290 DATA 0B,ED,4B,42,F2,3A,49,F2
52300 DATA 80,32,43,F2,2A,4E,F2,2B
52310 DATA 22,4E,F2,CB,7C,28,97,C9
52320 DATA 00,00,00,00,00,00,00,00
52330 DATA 00,00,00,00,00,00,00,00
52340 DATA 00,00,00,00
53000 '
53010 '**** POINT2-DATAs
53020 '
53030 FOR adr=&HF256 TO &HF262:READ a$:POKE adr,VAL("&H"+a$):NEXT
53040 DATA 7E,32,46,F2,EB,5E,23,56
53050 DATA ED,53,47,F2,C9
54000 '
54010 '**** ADRESSEN
54020 '
54030 setchar=&HF000:setpoint=&HF0BA:point2=&HF256:draw=&HF162
54040 RETURN