home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun 1985 Winter
/
rerun-1985-winter.d64
/
screenmaker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
7KB
|
262 lines
1 rem ********************************
2 rem * *
3 rem * 'screenmaker 64' (c) 1985 *
4 rem * *
5 rem * doug smoak *
6 rem * 303 heyward st. *
7 rem * columbia, s.c. 29201 *
8 rem * *
9 rem ********************************
10 bo=53280:bg=bo+1:poke56296,12:poke56297,12
20 pokebo,12:pokebg,12:print"[147][151]setting up";:dimb$(63)
30 reada:ifa>-1thenpoke680+i,a:i=i+1:print".";:goto30
40 print"[147]":poke252,4:poke254,192:sys680
50 gosub1980
60 dn$="":bl$=" "
70 dn$=dn$+bl$+dn$:nl$=chr$(0)
80 mn$="[221] [221]"
90 t1$="[147][151] screenmaker 64 [146]"
100 printt1$
110 pokebo,12:pokebg,12
120 print"choose one:"
130 print"c_create a screen"
140 print"l_load/edit a screen"
150 print"e_end"
160 getg$
170 ifg$="c"then240
180 ifg$="l"then1510
190 ifg$="e"thenprint"[147]":end
200 goto160
210 :
220 rem -------- create menu -----------
230 :
240 print"[147][151] create a screen [146]"
250 pokebo,12:pokebg,12
260 print"choose one:"
270 print"c_custom screen mode"
280 print"l_large text mode"
290 print"v_view menu"
300 print"m_main menu"
310 getg$
320 ifg$="v"then370
330 ifg$="m"then100
340 ifg$="c"thengosub790:goto570
350 ifg$="l"thengosub790:goto1750
360 goto310
370 print"[147][151] view menu [146]"
380 pokebo,12:pokebg,12
390 print"v_ view current screen"
400 print"c_ return to create menu"
410 print"m_ return to main menu"
420 print"[176][192][192][192][192][192][151] available from view mode[151] [192][192][192][192][192][174]":printmn$
430 print"[221] f1[155]_ change character color [151] [221]":printmn$
440 print"[221] f3[155]_ change background color[151] [221]":printmn$
450 print"[221] f5[155]_ change border color [151] [221]":printmn$
460 print"[221] f7[155]_ 1x printout [151]f8[155]_ 2x printout[151] [221]":printmn$
470 print"[221] s[155] _ save current screen [151] [221]"
480 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
490 getg$
500 ifg$="v"thengosub790:gosub930:goto370
510 ifg$="m"then100
520 ifg$="c"then240
530 goto490
540 :
550 rem -------- cursor routine --------
560 :
570 print"";
580 p=1024+peek(214)*40+peek(211)+(peek(211)>39)*40
590 ch=peek(p):k=128*(ch>127)-128*(ch<128)
600 pokep,ch+k:pokep+54272,peek(646):t=ti+2
610 ifti>tthenk=-128*(k=0)*(ch>127)+128*(k=0)*(ch<128):goto600
620 getz$:ifz$=""then610
630 ifz$="\"thenpokep,ch:gosub860:goto240
640 pokep,ch:printz$;
650 ifz$=chr$(34)thenpoke212,0
660 ifz$="[148]"thenpoke216,0
670 goto580
680 :
690 rem ------- error channel read -----
700 :
710 open15,8,15
720 input#15,a,b$,c,d:close15
730 return
740 geta$:ifa$=""then740
750 return
760 :
770 rem ---------- get screen ----------
780 :
790 poke252,192:poke254,4:sys680
800 poke252,196:poke254,216:sys680
810 pokebo,peek(56296):pokebg,peek(56297)
820 return
830 :
840 rem ---------- put screen ----------
850 :
860 poke252,4:poke254,192:sys680
870 poke56296,peek(bo):poke56297,peek(bg)
880 poke252,216:poke254,196:sys680
890 return
900 :
910 rem -------- view options ----------
920 :
930 getg$:ifg$=""then930
940 ifg$="s"thengosub860:goto1040
950 ifg$="[133]"thensys703:goto930
960 ifg$="[134]"thenpokebg,(peek(bg)+1)and15:poke56297,peek(bg):goto930
970 ifg$="[135]"thenpokebo,(peek(bo)+1)and15:poke56296,peek(bo):goto930
980 ifg$="[136]"thentx$=chr$(15):gosub1190
990 ifg$="[140]"thentx$=chr$(14):gosub1190
1000 gosub860:return
1010 :
1020 rem --------- save screen ---------
1030 :
1040 f1$="":f2$="":pokebo,12:pokebg,12
1050 open15,8,15,"ui":close15
1060 print"[147][151]screen name";
1070 inputf1$:iff1$=""thenreturn
1080 iflen(f1$)>14then1060
1090 print"save color too? [y/n]"
1100 geta$:ifa$<>"y"anda$<>"n"then1100
1110 gosub790
1120 fs=1:ifa$="y"thenfs=2:f2$=f1$+".c"
1130 f$=f1$:s=1024:e=2024:gosub1330:gosub1390:ifathenreturn
1140 iffs=2thenf$=f2$:s=55296:e=56298:gosub1330:gosub1390
1150 return
1160 :
1170 rem --------- screen dump ---------
1180 :
1190 r$=chr$(145):v$=chr$(146):open4,4:cmd4:g=peek(648)*256
1200 printr$+tx$;
1210 forp=gtog+999
1220 c=peek(p):c$=""
1230 if(p-g)/40=int((p-g)/40)thenprintchr$(8)+chr$(13)+tx$;
1240 ifc>128thenc=c-128:c$=chr$(18)
1250 ifc<32orc>95thenc=c+64:goto1270
1260 ifc>63andc<96thenc=c+128
1270 c$=c$+chr$(c):iflen(c$)>1thenc$=c$+v$+r$
1280 printc$;:next:print#4:close4
1290 return
1300 :
1310 rem -------- put filename ---------
1320 :
1330 fori=1tolen(f$):poke749+i,asc(mid$(f$,i,1)):next
1340 poke183,len(f$):poke187,238:poke188,2:poke186,8:poke185,1
1350 return
1360 :
1370 rem --------- save sub ------------
1380 :
1390 sh=int(s/256):sl=s-sh*256
1400 eh=int(e/256):el=e-eh*256
1410 poke251,sl:poke252,sh
1420 poke780,251:poke781,el:poke782,eh
1430 sys65496
1440 gosub710:ifa=0thenreturn
1450 print"[147]"dn$"disk error "a;b$""
1460 gosub740
1470 return
1480 :
1490 rem --------- load screen ---------
1500 :
1510 f1$="":f2$=""
1520 print"[147]exact screen name";
1530 inputf1$:iff1$=""then100
1540 iflen(f1$)>14then1520
1550 print"load color too? [y/n]"
1560 geta$:ifa$<>"y"anda$<>"n"then1560
1570 fs=1:ifa$="y"thenfs=2:f2$=f1$+".c"
1580 f$=f1$:gosub1330:poke780,0:sys65493
1590 gosub710:ifa=0then1630
1600 printdn$"disk error"a;b$""
1610 gosub740
1620 goto100
1630 iffs=2thenf$=f2$:gosub1330:poke780,0:sys65493
1640 gosub710:ifa=0then1690
1650 gosub860
1660 printdn$"color file not loaded"
1670 gosub740
1680 goto370
1690 pokebo,peek(56296):pokebg,peek(56297)
1700 gosub860
1710 goto370
1720 :
1730 rem ------- large text ------------
1740 :
1750 print"";
1760 gosub1910
1770 ifleft$(m$,1)="\"thengosub860:goto240
1780 ifleft$(m$,1)="_"thenm$=right$(m$,len(m$)-1):goto1810
1790 ml=(40-len(m$)*4)/2
1800 ifml>0thenfori=1toml:print"";:next
1810 fori=1tolen(m$)
1820 a$=mid$(m$,i,1)
1830 a=asc(a$+nl$)+64*(asc(a$+nl$)>63)
1840 printb$(a);:next:print""
1850 getg$:ifg$=""then1850
1860 ifg$="\"thengosub860:goto240
1870 print:goto1760
1880 :
1890 rem ------- get text line ---------
1900 :
1910 m$="":printdn$"[166][157]";
1920 getg$:ifg$=""then1920
1930 ifasc(g$)>31andasc(g$)<96thenm$=m$+g$
1940 ifg$=chr$(20)org$=chr$(157)thenm$=left$(m$,len(m$)+1*(len(m$)>0))
1950 ifg$<>chr$(13)thenprint" [157]"g$"[166][157]";:goto1920
1960 ifm$=""thenm$=" "
1970 printdn$"[145]":return
1980 b$(0)=""
1990 b$(1)="[169] [223][157][157][157] [157][157][157] [162] [157][157][157] [145][145][145]"
2000 b$(2)=" [223][157][157][157] [157][157][157] [162] [157][157][157] [146][162] [145][145][145]"
2010 b$(3)=" [157][157][157] [162][157][157][157] [157] [146][162] [145][145][145]"
2020 b$(4)=" [223][157][157][157] [157][157][157] [157][157][157] [146][162] [145][145][145]"
2030 b$(5)=" [157][157][157] [157][157] [162][157][157] [146][162][162][145][145][145]"
2040 b$(6)=" [157][157][157] [157][157] [162][157][157] [146] [145][145][145]"
2050 b$(7)=" [157][157][157] [162][157][157][157] [146][172][162][157][157][157] [146][162] [145][145][145]"
2060 b$(8)=" [157][157][157] [157][157][157] [162] [157][157][157] [145][145][145]"
2070 b$(9)="[161][146][161][157][157][161][146][161][157][157][161][146][161][157][157][161][146][161][145][145][145]"
2080 b$(10)=" [157] [157] [157][157][157] [146][162] [145][145][145]"
2090 b$(11)=" [157][157][157] [169][146][169][157][157][157] [146][223][223][157][157][157] [145][145][145]"
2100 b$(12)=" [157] [157][157] [157] [146][162][162][145][145][145]"
2110 b$(13)=" [223][169] [157][157][157][157] [146][223][169] [157][157][157][157] [157][157][157][157] [145][145][145]"
2120 b$(14)=" [223] [157][157][157] [146][223] [157][157][157] [157][157][157] [145][145][145]"
2130 b$(15)=" [157][157][157] [157][157][157] [157][157][157] [146][162] [146][145][145][145]"
214