home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_24_1988_Transactor_Publishing.d64 / geosdemo_pal (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  11KB  |  625 lines
  1. 1000 ;
  2. 1005 ;rem save"geosdemo/pal",8
  3. 1010 ;
  4. 1015 ;rem  f.g.kostella 12/10/87
  5. 1020 ;
  6. 1025 * = $0304
  7. 1030 ;
  8. 1035 ;zpage pseudoregisters
  9. 1040 ;
  10. 1045 r0 = $02
  11. 1050 r0l = $02
  12. 1055 r0h = $03
  13. 1060 r1 = $04
  14. 1065 r1l = $04
  15. 1070 r1h = $05
  16. 1075 r11 = $18
  17. 1080 r11l = $18
  18. 1085 r11h = $19
  19. 1090 ;
  20. 1095 ;geos routines
  21. 1100 ;
  22. 1105 domenu = $c151
  23. 1110 redomenu = $c193
  24. 1115 dopreviousme = $c190 ;dopreviousmenu
  25. 1120 gotofirstmen = $c1bd ;gotofirstmenu
  26. 1125 drawline = $c130
  27. 1130 setpattern = $c139
  28. 1135 drawpoint = $c133
  29. 1140 rectangle = $c124
  30. 1145 i.rectangle = $c19f
  31. 1150 framerectang = $c127 ;framerectangle
  32. 1155 i.framerecta = $c1a2 ;i.framerectangle
  33. 1160 bitmapup = $c124
  34. 1165 i.bitmapup = $c1ab
  35. 1170 doicons = $c15a
  36. 1175 dodlgbox = $c256
  37. 1180 rstrfrmdialo = $c2bf ;rstrfrmdialog
  38. 1185 putstring = $c148
  39. 1190 i.putstring = $c1ae
  40. 1195 putdecimal = $c184
  41. 1200 enterdesktop = $c22c
  42. 1205 ;
  43. 1210 stringfaultv = $84ab ;stringfaultvector
  44. 1215 sysdbdata = $851d
  45. 1220 ;
  46. 1225 ;------------------------------
  47. 1230 ;header block starts at $0304
  48. 1235 ;ram based assemblers may need
  49. 1240 ;to change start address.
  50. 1245 ;------------------------------
  51. 1250 ;-assemble the header block here-
  52. 1255 ;            -note-
  53. 1260 ;1st 4 bytes commented out here
  54. 1265 ;they will be placed in the
  55. 1270 ;geos file header by "maketogeos"
  56. 1275 ;.byte 0,255 ; 1 sector
  57. 1280 ;.byte 3,21  ; 3x21 icon
  58. 1285 ;--------------------------------
  59. 1290 ;define icon to appear on desk top
  60. 1295 .byte $bf ;$80 (straight bitmap) + 63 data bytes
  61. 1300 .byte %11111111,%11111111,%11111000
  62. 1305 .byte %10000000,%00000000,%00001000
  63. 1310 .byte %10000000,%00000000,%00001000
  64. 1315 .byte %10011101,%11011101,%11001111
  65. 1320 .byte %10001001,%00010000,%10001111
  66. 1325 .byte %10001001,%11001000,%10001111
  67. 1330 .byte %10001001,%00000100,%10001111
  68. 1335 .byte %10001001,%11011100,%10001111
  69. 1340 .byte %10000000,%00000000,%00001111
  70. 1345 .byte %10000000,%00000000,%00001111
  71. 1350 .byte %10011101,%11010001,%11001111
  72. 1355 .byte %10010000,%10010001,%00001111
  73. 1360 .byte %10011100,%10010001,%11001111
  74. 1365 .byte %10010000,%10010001,%00001111
  75. 1370 .byte %10010001,%11011101,%11001111
  76. 1375 .byte %10000000,%00000000,%00001111
  77. 1380 .byte %10000000,%00000000,%00001111
  78. 1385 .byte %11111111,%11111111,%11111111
  79. 1390 .byte %00011111,%11111111,%11111111
  80. 1395 .byte %00011111,%11111111,%11111111
  81. 1400 .byte %00011111,%11111111,%11111111
  82. 1405 ;
  83. 1410 .byte $83 ;c64 filetype usr
  84. 1415 .byte 6 ;application
  85. 1420 .byte 0 ;geos seq file
  86. 1425 ;
  87. 1430 .word startaddress ;load start addr
  88. 1435 .word endofcode ;load end addr
  89. 1440 .word startjump ;start addr jump
  90. 1445 ;
  91. 1450 .byte 'filename    v1.1' ;perm name string
  92. 1455 .byte 0,0,0,0 ;
  93. 1460 .byte 'author name     '
  94. 1465 ;
  95. 1470 ;the rest of the header block
  96. 1475 ;is not used in this file
  97. 1480 ;
  98. 1485 ; ------------------------------
  99. 1490 ;ram based assemblers change addr
  100. 1495 * =$0400
  101. 1500 ; ------------------------------
  102. 1505 ;
  103. 1510 startaddress =* ;save start
  104. 1515 startjump =*
  105. 1520 ;
  106. 1525 ;   clean screen
  107. 1530 lda #0
  108. 1535 jsr setpattern
  109. 1540 jsr i.rectangle
  110. 1545 .byte 0
  111. 1550 .byte 199
  112. 1555 .word 0
  113. 1560 .word 319
  114. 1565 lda #$ff
  115. 1570 jsr framerectang
  116. 1575 ;
  117. 1580 ;1 icon required at all times, so
  118. 1585 ;
  119. 1590 ldx #<dumbicondata ;dummy until
  120. 1595 ldy #>dumbicondata ;we need one
  121. 1600 stx r0l
  122. 1605 sty r0h
  123. 1610 jsr doicons
  124. 1615 ;  menus
  125. 1620 ldx #<ourmenu
  126. 1625 ldy #>ourmenu
  127. 1630 stx r0l
  128. 1635 sty r0h
  129. 1640 lda #1
  130. 1645 jsr domenu
  131. 1650 ; that's all!, rts to main loop
  132. 1655 rts
  133. 1660 ;==============================
  134. 1665 dumbicondata =*
  135. 1670 .byte 1 ;# of icons
  136. 1675 .word 319 ;leave mouse x pos,
  137. 1680 .byte 199 ;y pos
  138. 1685 ;
  139. 1690 .word 0 ;icon bitmap addr
  140. 1695 .byte 36,1 ;h pos.byte(/8),v pos. pixel
  141. 1700 .byte 1,1 ;w+h
  142. 1705 .word 0 ;dispatch rtn
  143. 1710 ;===============================
  144. 1715 ;... menu structure...
  145. 1720 ourmenu =*
  146. 1725 .byte 0 ;main top
  147. 1730 .byte 13 ;main bottom
  148. 1735 .word 0 ;main left
  149. 1740 .word 80 ;main right
  150. 1745 .byte 2 ;horz ($00) or'ed w/ # menu items
  151. 1750 ;
  152. 1755 .word filemenutext
  153. 1760 .byte $80 ;sub menu constant
  154. 1765 .word filemenu ;rtn
  155. 1770 ;
  156. 1775 .word operatetext
  157. 1780 .byte $80
  158. 1785 .word operatemenu
  159. 1790 ;
  160. 1795 ;text for main selections
  161. 1800 filemenutext .byte 'file'
  162. 1805 .byte 0
  163. 1810 operatetext .byte 'operations'
  164. 1815 .byte 0
  165. 1820 ;
  166. 1825 ;..submenus...
  167. 1830 ;
  168. 1835 filemenu =*
  169. 1840 .byte 13
  170. 1845 .byte 27
  171. 1850 .word 0
  172. 1855 .word 33
  173. 1860 .byte $81 ;vert ored w/ # items
  174. 1865 ;
  175. 1870 .word filequittext
  176. 1875 .byte 0 ;menu action
  177. 1880 .word doexit ;rtn
  178. 1885 ;
  179. 1890 filequittext .byte 'quit'
  180. 1895 .byte 0
  181. 1900 ;
  182. 1905 doexit =*
  183. 1910 jmp enterdesktop
  184. 1915 ;
  185. 1920 operatemenu =*
  186. 1925 .byte 13,55 ;top,bot
  187. 1930 .word 23,80 ;left,right
  188. 1935 .byte $83 ;vertical or'd w/ #
  189. 1940 ;
  190. 1945 .word op0text
  191. 1950 .byte 0 ;menu action
  192. 1955 .word op0rtn
  193. 1960 ;
  194. 1965 .word op1text
  195. 1970 .byte 0
  196. 1975 .word mover
  197. 1980 ;
  198. 1985 .word op2text
  199. 1990 .byte 0
  200. 1995 .word sizer
  201. 2000 ;
  202. 2005 op0text .byte 'pattern'
  203. 2010 .byte 0
  204. 2015 op1text .byte 'mover'
  205. 2020 .byte 0
  206. 2025 op2text .byte 'sizer'
  207. 2030 .byte 0
  208. 2035 ;-------------------------
  209. 2040 ourpattern .word 0
  210. 2045 ;
  211. 2050 op0rtn =*
  212. 2055 jsr gotofirstmen
  213. 2060 ;
  214. 2065 lda ourpattern
  215. 2070 and #%00011111
  216. 2075 sta ourpattern
  217. 2080 jsr setpattern
  218. 2085 jsr i.rectangle
  219. 2090 .byte 13
  220. 2095 .byte 199
  221. 2100 .word 0
  222. 2105 .word 319
  223. 2110 lda #$ff
  224. 2115 jsr framerectang
  225. 2120 ;
  226. 2125 jsr i.putstring
  227. 2130 .word 92
  228. 2135 .byte 10
  229. 2140 .byte 'pattern:   '
  230. 2145 .byte 0
  231. 2150 ;
  232. 2155 ldx #132
  233. 2160 ldy #0
  234. 2165 stx r11l
  235. 2170 sty r11h
  236. 2175 ldy #10
  237. 2180 sty r1+1
  238. 2185 ldx ourpattern
  239. 2190 ldy #0
  240. 2195 stx r0
  241. 2200 sty r0+1
  242. 2205 lda #%11000000
  243. 2210 jsr putdecimal
  244. 2215 ;
  245. 2220 inc ourpattern
  246. 2225 rts
  247. 2230 ;
  248. 2235 ;---------------------------
  249. 2240 ;values used to add to pos bytes
  250. 2245 dbtop .byte 0
  251. 2250 dbbottom .byte 0
  252. 2255 dbleft .byte 0
  253. 2260 dbright .byte 0
  254. 2265 ;=====
  255. 2270 mover =*
  256. 2275 jsr gotofirstmen
  257. 2280 ;
  258. 2285 dodbagain =*
  259. 2290 jsr clearadder
  260. 2295 ldx #<ourdbtable
  261. 2300 ldy #>ourdbtable
  262. 2305 stx r0l
  263. 2310 sty r0h
  264. 2315 jsr dodlgbox
  265. 2320 lda r0 ;returned by db
  266. 2325 bmi doourrtns
  267. 2330 ;  its 'ok'
  268. 2335 rts
  269. 2340 ;
  270. 2345 doourrtns =*
  271. 2350 cmp #$82
  272. 2355 bcs ourrtns1
  273. 2360 lda #2
  274. 2365 sta dbtop
  275. 2370 sta dbbottom
  276. 2375 jsr dbsubtract
  277. 2380 jmp ourrtns4
  278. 2385 ;
  279. 2390 ourrtns1 =*
  280. 2395 cmp #$83
  281. 2400 bcs ourrtns2
  282. 2405 lda #2
  283. 2410 sta dbleft
  284. 2415 sta dbright
  285. 2420 jsr dbsubtract
  286. 2425 jmp ourrtns4
  287. 2430 ;
  288. 2435 ourrtns2 =*
  289. 2440 cmp #$84
  290. 2445 bcs ourrtns3
  291. 2450 lda #2
  292. 2455 sta dbtop
  293. 2460 sta dbbottom
  294. 2465 jsr dbadd
  295. 2470 jmp ourrtns4
  296. 2475 ;
  297. 2480 ourrtns3 =*
  298. 2485 lda #2
  299. 2490 sta dbleft
  300. 2495 sta dbright
  301. 2500 jsr dbadd
  302. 2505 ;
  303. 2510 ourrtns4 =*
  304. 2515 jsr displayvals
  305. 2520 jmp dodbagain
  306. 2525 ;
  307. 2530 ;-----------------------------
  308. 2535 ;use the same db, process
  309. 2540 ;the results differently
  310. 2545 ;
  311. 2550 sizer =*
  312. 2555 jsr gotofirstmen
  313. 2560 ;
  314. 2565 dodbagainz =*
  315. 2570 jsr clearadder
  316. 2575 ldx #<ourdbtable
  317. 2580 ldy #>ourdbtable
  318. 2585 stx r0l
  319. 2590 sty r0h
  320. 2595 jsr dodlgbox
  321. 2600 lda r0 ;returned by db
  322. 2605 bmi doourrtnsz
  323. 2610 rts
  324. 2615 ;
  325. 2620 doourrtnsz =*
  326. 2625 cmp #$82
  327. 2630 bcs ourrtns1z
  328. 2635 lda #2
  329. 2640 sta dbtop
  330. 2645 jsr dbsubtract
  331. 2650 jsr clearadder
  332. 2655 lda #2
  333. 2660 sta dbbottom
  334. 2665 jsr dbadd
  335. 2670 jmp ourrtns4z
  336. 2675 ;
  337. 2680 ourrtns1z =*
  338. 2685 cmp #$83
  339. 2690 bcs ourrtns2z
  340. 2695 lda #2
  341. 2700 sta dbleft
  342. 2705 jsr dbsubtract
  343. 2710 jsr clearadder
  344. 2715 lda #2
  345. 2720 sta dbright
  346. 2725 jsr dbadd
  347. 2730 jmp ourrtns4z
  348. 2735 ;
  349. 2740 ourrtns2z =*
  350. 2745 cmp #$84
  351. 2750 bcs ourrtns3z
  352. 2755 lda #2
  353. 2760 sta dbtop
  354. 2765 jsr dbadd
  355. 2770 jsr clearadder
  356. 2775 lda #2
  357. 2780 sta dbbottom
  358. 2785 jsr dbsubtract
  359. 2790 jmp ourrtns4z
  360. 2795 ;
  361. 2800 ourrtns3z =*
  362. 2805 lda #2
  363. 2810 sta dbleft
  364. 2815 jsr dbadd
  365. 2820 jsr clearadder
  366. 2825 lda #2
  367. 2830 sta dbright
  368. 2835 jsr dbsubtract
  369. 2840 ;
  370. 2845 ourrtns4z =*
  371. 2850 jsr displayvals
  372. 2855 jmp dodbagainz
  373. 2860 ;
  374. 2865 ;----------db subs--------------
  375. 2870 ;
  376. 2875 clearadder =*
  377. 2880 lda #0
  378. 2885 sta dbtop
  379. 2890 sta dbbottom
  380. 2895 sta dbleft
  381. 2900 sta dbright
  382. 2905 rts
  383. 2910 ;
  384. 2915 dbsubtract =*
  385. 2920 sec
  386. 2925 lda ourdbtable+1 ;top of db
  387. 2930 sbc dbtop
  388. 2935 sta ourdbtable+1
  389. 2940 sec
  390. 2945 lda ourdbtable+2 ;bot of db
  391. 2950 sbc dbbottom
  392. 2955 sta ourdbtable+2
  393. 2960 sec
  394. 2965 lda ourdbtable+3 ;left of db
  395. 2970 sbc dbleft
  396. 2975 sta ourdbtable+3
  397. 2980 lda ourdbtable+4
  398. 2985 sbc #0
  399. 2990 sta ourdbtable+4
  400. 2995 sec
  401. 3000 lda ourdbtable+5 ;rightt of db
  402. 3005 sbc dbright
  403. 3010 sta ourdbtable+5
  404. 3015 lda ourdbtable+6
  405. 3020 sbc #0
  406. 3025 sta ourdbtable+6
  407. 3030 rts
  408. 3035 ;
  409. 3040 dbadd =*
  410. 3045 clc
  411. 3050 lda ourdbtable+1 ;top of db
  412. 3055 adc dbtop
  413. 3060 sta ourdbtable+1
  414. 3065 clc
  415. 3070 lda ourdbtable+2 ;bot of db
  416. 3075 adc dbbottom
  417. 3080 sta ourdbtable+2
  418. 3085 clc
  419. 3090 lda ourdbtable+3 ;left of db
  420. 3095 adc dbleft
  421. 3100 sta ourdbtable+3
  422. 3105 lda ourdbtable+4
  423. 3110 adc #0
  424. 3115 sta ourdbtable+4
  425. 3120 clc
  426. 3125 lda ourdbtable+5 ;rightt of db
  427. 3130 adc dbright
  428. 3135 sta ourdbtable+5
  429. 3140 lda ourdbtable+6
  430. 3145 adc #0
  431. 3150 sta ourdbtable+6
  432. 3155 rts
  433. 3160 ;
  434. 3165 ;
  435. 3170 displayvals =*
  436. 3175 ;
  437. 3180 lda #0
  438. 3185 jsr setpattern
  439. 3190 jsr i.rectangle
  440. 3195 .byte 1
  441. 3200 .byte 11
  442. 3205 .word 239
  443. 3210 .word 318
  444. 3215 ;
  445. 3220 ldx #210
  446. 3225 ldy #0
  447. 3230 stx r11l
  448. 3235 sty r11h
  449. 3240 ldy #10
  450. 3245 sty r1h
  451. 3250 ldx ourdbtable+1
  452. 3255 ldy #0
  453. 3260 stx r0l
  454. 3265 sty r0h
  455. 3270 lda #%11000000
  456. 3275 jsr putdecimal
  457. 3280 ;
  458. 3285 ldx #235
  459. 3290 ldy #0
  460. 3295 stx r11l
  461. 3300 sty r11h
  462. 3305 ldx ourdbtable+2
  463. 3310 ldy #0
  464. 3315 stx r0
  465. 3320 sty r0h
  466. 3325 lda #%11000000
  467. 3330 jsr putdecimal
  468. 3335 ;
  469. 3340 ldx #4
  470. 3345 ldy #1
  471. 3350 stx r11l
  472. 3355 sty r11h
  473. 3360 ldx ourdbtable+3
  474. 3365 ldy ourdbtable+4
  475. 3370 stx r0
  476. 3375 sty r0h
  477. 3380 lda #%11000000
  478. 3385 jsr putdecimal
  479. 3390 ;
  480. 3395 ldx #29
  481. 3400 ldy #1
  482. 3405 stx r11l
  483. 3410 sty r11h
  484. 3415 ldx ourdbtable+5
  485. 3420 ldy ourdbtable+6
  486. 3425 stx r0
  487. 3430 sty r0h
  488. 3435 lda #%11000000
  489. 3440 jsr putdecimal
  490. 3445 rts
  491. 3450 ;------------------------------
  492. 3455 ourdbtable =*
  493. 3460 ;
  494. 3465 .byte $01 ;pos/shadow patrn
  495. 3470 ;
  496. 3475 .byte 50 ;top
  497. 3480 .byte 86 ;bott
  498. 3485 .word 48 ;left
  499. 3490 .word 120 ;right
  500. 3495 ;
  501. 3500 .byte 1 ;ok
  502. 3505 .byte 1 ;x byt
  503. 3510 .byte 16 ;y pixel
  504. 3515 ;
  505. 3520 .byte $12 ;user icon
  506. 3525 .byte 1 ;x offset
  507. 3530 .byte 4 ;y offset
  508. 3535 .word dbicon1 ;addr of icon table
  509. 3540 ;
  510. 3545 .byte $12
  511. 3550 .byte 3,4
  512. 3555 .word dbicon2
  513. 3560 ;
  514. 3565 .byte $12
  515. 3570 .byte 5,4
  516. 3575 .word dbicon3
  517. 3580 ;
  518. 3585 .byte $12
  519. 3590 .byte 7,4
  520. 3595 .word dbicon4
  521. 3600 ;
  522. 3605 .byte 0 ;end
  523. 3610 ;--------------------------
  524. 3615 ;db user icon tables, graphics
  525. 3620 ;& service routines for mover
  526. 3625 ;
  527. 3630 dbicon1 =*
  528. 3635 .word dbi1bitmap ;addr of picture data
  529. 3640 .byte 0,0 ;x,y-already set!
  530. 3645 .byte 1 ;bytes wide
  531. 3650 .byte 8 ;pixels hi
  532. 3655 .word dbi1rtn ;addr of svc rtn
  533. 3660 ;
  534. 3665 dbi1bitmap =*
  535. 3670 ;
  536. 3675 .byte $88 ;format 2, use the next 8 bytes
  537. 3680 .byte %11111111
  538. 3685 .byte %11100111
  539. 3690 .byte %11000011
  540. 3695 .byte %10000001
  541. 3700 .byte %11100111
  542. 3705 .byte %11100111
  543. 3710 .byte %11100111
  544. 3715 .byte %11111111
  545. 3720 ;
  546. 3725 dbi1rtn =*
  547. 3730 ;
  548. 3735 lda #$81
  549. 3740 sta sysdbdata
  550. 3745 ;  and get out
  551. 3750 jmp rstrfrmdialo
  552. 3755 ; -------------------------
  553. 3760 dbicon2 =*
  554. 3765 .word dbi2bitmap
  555. 3770 .byte 0,0,1,8
  556. 3775 .word dbi2rtn
  557. 3780 ;
  558. 3785 dbi2bitmap =*
  559. 3790 .byte $88
  560. 3795 .byte %11111111
  561. 3800 .byte %11101111
  562. 3805 .byte %11001111
  563. 3810 .byte %10000001
  564. 3815 .byte %10000001
  565. 3820 .byte %11001111
  566. 3825 .byte %11101111
  567. 3830 .byte %11111111
  568. 3835 ;
  569. 3840 dbi2rtn =*
  570. 3845 lda #$82
  571. 3850 sta sysdbdata
  572. 3855 jmp rstrfrmdialo
  573. 3860 ;
  574. 3865 ;
  575. 3870 dbicon3 =*
  576. 3875 .word dbi3bitmap
  577. 3880 .byte 0,0,1,8
  578. 3885 .word dbi3rtn
  579. 3890 ;
  580. 3895 dbi3bitmap =*
  581. 3900 .byte $88
  582. 3905 .byte %11111111
  583. 3910 .byte %11100111
  584. 3915 .byte %11100111
  585. 3920 .byte %11100111
  586. 3925 .byte %10000001
  587. 3930 .byte %11000011
  588. 3935 .byte %11100111
  589. 3940 .byte %11111111
  590. 3945 ;
  591. 3950 dbi3rtn =*
  592. 3955 ;
  593. 3960 lda #$83
  594. 3965 sta sysdbdata
  595. 3970 jmp rstrfrmdialo
  596. 3975 ; -------------------------
  597. 3980 ;
  598. 3985 ;
  599. 3990 dbicon4 =*
  600. 3995 .word dbi4bitmap
  601. 4000 .byte 0,0,1,8
  602. 4005 .word dbi4rtn
  603. 4010 ;
  604. 4015 dbi4bitmap =*
  605. 4020 ;
  606. 4025 .byte $88
  607. 4030 .byte %11111111
  608. 4035 .byte %11110111
  609. 4040 .byte %11110011
  610. 4045 .byte %10000001
  611. 4050 .byte %10000001
  612. 4055 .byte %11110011
  613. 4060 .byte %11110111
  614. 4065 .byte %11111111
  615. 4070 ;
  616. 4075 dbi4rtn =*
  617. 4080 lda #$84
  618. 4085 sta sysdbdata
  619. 4090 jmp rstrfrmdialo
  620. 4095 ;
  621. 4100 endofcode =*
  622. 4105 .end
  623. 4110 ;
  624. 4115 thats all folks!!
  625.