Transactor/Transactor_27_1988_Transactor_Publishing.d64/icondef.sda/ICON-DEFINER.SRC

Commodore BASIC | 2023-02-26 | 15KB | 686 lines

1000 open2,8,1,"0:id"
1010 sys700
1020 ;opt oo
1030 .opt o2
1040 ;
1045 start = $0304
1050 ;--equates--
1060 r0 =$02
1070 r1 =$04
1080 r2 =$06
1090 r5 =$0c
1100 r7 =$10
1110 r9 =$14
1120 r10 =$16
1130 a2 =$70
1140 a3 =$72
1150 a4 =$74
1160 disbuf =$2f ;fore/back screen write (displaybufferon)
1170 ;
1180 pload =$0b00 ; load photo here, is also width byte
1190 pdepth =$0b01 ; depth stored here
1200 pstart =$0b03 ; 1st byte of bitmap
1210 sbegin =$20d0 ;start seq save here
1220 ; max 349 lines of 16 bytes each
1230 recvec = $84b1 ;recover screen from dialog box
1240 :
1250 ;
1260 ;
1270 ;
1280 ;
1290 ;
1300 ;
1310 *= start
1315 ;
1320 ;1st 4 bytes commented out
1330 ; they will be placed in the
1340 ; file header by "maketogeos"
1350 ;.byte $00,$ff
1360 ;.byte 3,21 ; 3x21 icon
1370 .byte $bf,$ff,$ff,$ff,$82,$20,$01
1375 .byte $84,$50,$01,$89,$88,$01
1380 .byte $84,$84,$01,$8e,$52,$01,$87
1385 .byte $31,$01,$83,$98,$81,$81,$c1,$81,$f4
1390 .byte $e3,$01,$8c,$ff,$01,$f4,$a1,$01
1395 .byte $84,$52,$01,$84,$52,$c1,$84,$a1
1400 .byte $79,$84,$80,$55,$8f,$a0,$6d,$84
1405 .byte $a1,$57,$80,$52,$cb,$80,$3c,$0d
1410 .byte $ff,$ff,$ff
1420 ;
1430 .byte $83 ;c= filetype user
1440 .byte 6 ;application
1450 .byte 0 ;geos seq file
1460 .word saddr ;start addr
1470 .word endcod ;end addr
1480 .word stjump ;start addr jump
1490 ;
1500 .asc "icon definerv1.0"
1510 .byte 0,0,0,0
1520 .asc "f.g.kostella"
1530 .byte 0,0,0,0
1540 ;
1550 ;the rest of the header is not used here
1560 ;
1570 ;
1580 ;---start geos file----
1590 *= start+$fc
1600 stjump =* ;these are the starting points
1610 saddr =* ;specified in this file's header
1620 lda #1
1630 sta erflag ;for first call
1640 jsr clrscr ;give instructions
1650 jsr doicon ;do icons
1660 rts  ; to main loop
1670 ;--- initial screen ---
1680 clrscr =*
1690 lda #0
1700 jsr $c139 ; setpattern (setpat)
1710 jsr $c19f ; i.rectangle (pfill2)
1720 .byte 0,199
1730 .wor 0,319
1740 ; turn off the background screen
1750 ; (we're using that ram)
1760 ; insert our own routine into the
1770 ; db screen recover vector.
1780 lda disbuf
1790 and #%10111111 ;bit 6=background enable
1800 sta disbuf
1810 lda #<recovr ;our routine
1820 sta recvec   ;geos vector
1830 lda #>recovr
1840 sta recvec+1
1850 ;
1860 jsr $c1a2 ;i.framerectangle (pbox2)
1870 .byte 0,16
1880 .wor 144,319
1890 .byte $ff ;solid line
1900 ; print some user help info
1910 ; first draw the 'fake' icons
1920 jsr $c1ab ;i.bitmapup (cbox2)
1930 .wor iconch
1940 .byte 3,60,6,16
1950 jsr $c1ab
1960 .wor larrow
1970 .byte 3,84,3,16
1980 jsr $c1ab
1990 .wor rarrow
2000 .byte 3,108,3,16
2010 jsr $c1ab
2020 .wor iconsa
2030 .byte 3,132,6,16
2040 ; tell what they do
2050 jsr $c1ae ; i.putstring (dsptx2)
2060 .wor 24
2070 .byte 40, 24
2080 .asc "icon definer  v1.0"
2090 .byte 0
2100 jsr $c1ae
2110 .wor 24
2120 .byte 52
2130 .asc "by f. g. kostella for "
2140 .byte 14 ;underline on
2150 .asc "the transactor"
2160 .byte 15,0 ;off
2170 jsr $c1ae
2180 .wor 80
2190 .byte 72
2200 .asc "a photo album"
2210 .byte 0
2220 jsr $c1ae
2230 .wor 56
2240 .byte 96
2250 .asc "previous album record"
2260 .byte 0
2270 jsr $c1ae
2280 .wor 56
2290 .byte 120
2300 .asc "next album record"
2310 .byte 0
2320 jsr $c1ae
2330 .wor 80
2340 .byte 144
2350 .asc "current album record"
2360 .byte 0
2370 rts
2380 ;--- icons ---
2390 doicon =* ;put up icons
2400 lda #<myicon
2410 sta r0
2420 lda #>myicon
2430 sta r0+1
2440 jsr $c15a ; doicons (cboxes)
2450 rts
2460 ;
2470 myicon =* ;icon tables
2480 .byte 5,99,0,99 ; #, x&y pointer
2490 .wor iconch ;graphic pointer
2500 .byte 0,0,6,16 ;x,y,w,h dimensions
2510 .wor choose ;svc rtn pointer
2520 .wor iconex
2530 .byte 38,0,2,16
2540 .wor doexit
2550 .wor larrow
2560 .byte 6,0,3,16
2570 .wor dolast
2580 .wor rarrow
2590 .byte 9,0,3,16
2600 .wor donext
2610 .wor iconsa
2620 .byte 12,0,6,16
2630 .wor saveit
2640 ;--- icon service routines ---
2650 doexit =* ;quit application
2660 jmp $c22c ; enterdesktop (restrt)
2670 ;---
2680 choose =* ;choose a photo album
2690 jsr findfl ;put up file names
2700 cmp #2 ; cancel selected
2710 beq choos2
2720 lda #0 ; start with rec #0
2730 sta recnum
2740 jmp getit
2750 choos2 =*
2760 rts
2770 ;---
2780 donext =* ; next record
2790 inc recnum
2800 bpl donex2
2810 lda #0
2820 sta recnum
2830 donex2 =*
2840 jmp getit
2850 ;---
2860 dolast =* ; previous record
2870 dec recnum
2880 bpl getit
2890 lda #0
2900 sta recnum
2910 ;
2920 getit =* ; put up filename
2930 jsr doname
2940 jsr getrec ;and get the record
2950 rts
2960 ;---
2970 saveit =*
2980 jsr getfnm ;prompt for save name
2990 cmp #2 ;cancel selected
3000 beq save2
3010 jsr recbyt ;translate
3020 jsr savseq ;save to disk
3030 save2 =*
3040 rts
3050 ;--- setup & call db to get filename ---
3060 getfnm =* ;user enters name of file
3070 ;  clear out filename buffer
3080 ldy #16
3090 lda #0
3100 getfn2 =*
3110 sta svname,y
3120 dey
3130 bpl getfn2
3140 ;  r5 to hold selected name in db
3150 lda #<svname
3160 sta r5
3170 lda #>svname
3180 sta r5+1
3190 lda #<getndb ;addr of db table
3200 sta r0
3210 lda #>getndb
3220 sta r0+1
3230 jsr $c256 ; dodlgbox (window)
3240 lda r0 ; .a holds #2 if cancel
3250 rts ;return it to caller
3260 ;---
3270 ; db table
3280 getndb =* ;return save name in r5 pointer
3290 .byte $81 ;standard position
3300 .byte 2,16,68 ;cancel icon
3310 .byte 11,16,16 ; textstr cmnd
3320 .wor gnmstr ;  pointer
3330 .byte 13,16,30,$0c,16,0 ;getstr db cmnd ($0c = r5)
3340 ;
3350 gnmstr =*
3355 .byte 24
3360 .asc "please enter filename"
3370 .byte 27,0
3380 ;
3390 ;--- setup & call db to find photo albums on disk ---
3400 findfl =*
3410 ;  clear out the phname
3420 ldy #16
3430 lda #0
3440 fifl2 =*
3450 sta phname,y
3460 dey
3470 bpl fifl2
3480 ; search for this geos file type:
3490 lda #7 ; appl. data
3500 sta r7
3510 ; return selected file name in
3520 lda #<phname
3530 sta r5
3540 lda #>phname
3550 sta r5+1
3560 ; search for files with this
3570 ; permanant name
3580 lda #<permnm
3590 sta r10
3600 lda #>permnm
3610 sta r10+1
3620 lda #<ffildb ;addr of db table
3630 sta r0
3640 lda #>ffildb
3650 sta r0+1
3660 jsr $c256 ;dodlgbox
3670 lda r0
3680 rts ; r0 is in .a
3690 ;
3700 ; db table
3710 ffildb =*
3720 .byte $81 ;standard
3730 .byte 16,4,4 ; getfiles cmnd
3740 .byte 5,17,24 ; open icon
3750 .byte 2,17,72,0 ; cancel
3760 ;-----
3770 ; print filename to screen
3780 doname =*
3790 lda #9 ;horz lines
3800 jsr $c139
3810 jsr $c19f
3820 .byte 0,15
3830 .wor 145,303
3840 jsr $c1ae ;space, set pos.
3850 .wor 160
3860 .byte 10 ,32 ,0
3870 lda #<phname ;selected file
3880 sta r0
3890 lda #>phname
3900 sta r0+1
3910 jsr $c148
3920 lda #47 ;slash
3930 jsr $c145 ; putchar (dspchr)
3940 lda recnum ;record #
3950 sta r0
3960 lda #0
3970 sta r0+1
3980 lda #$c0 ;flush left
3990 jsr $c184 ; putdecimal (dspnum)
4000 lda #32 ;space
4010 jsr $c145
4020 rts
4030 ;---
4040 dogrid =* ;draw grid behind bitmap
4050 lda #16
4060 jsr $c139 ; setpattern
4070 jsr $c19f ; i-rectangle
4080 .byte 16,199
4090 .word 0,319
4100 rts
4110 ;--- error rtns ---
4120 norec =*
4130 jsr $c1ae ; i.putstring
4140 .word 110
4150 .byte 102
4160 .asc " empty record "
4170 .byte 0
4180 lda #1
4190 sta erflag
4200 jsr $c277 ;closerecordfile (vclose)
4210 rts
4220 ;--
4230 derror =* ;err # is in .a
4240 pha
4250 jsr $c1ae ; i-putstring
4260 .wor 110
4270 .byte 102
4280 .asc " -disk error- #"
4290 .byte 0
4300 pla
4310 pha
4320 sta r0
4330 lda #0
4340 sta r0+1
4350 lda #$c0 ;flush left
4360 jsr $c184 ; putdecimal (dspnum)
4370 lda #32
4380 jsr $c145
4390 lda #1
4400 sta erflag
4410 jsr $c277
4420 pla ; err 11 = too long
4430 cmp #11 ;was the record too long
4440 bne derr2
4450 jsr $c1ae ; i-putstring
4460 .word 110
4470 .byte 111
4480 .asc " -record too long- "
4490 .byte 0
4500 derr2 =*
4510 rts
4520 ;
4530 erflag .byte 0
4540 ;--- draw the photo ---
4550 drawph =* ;draw selected photo
4560 lda #>pstart
4570 sta r0+1
4580 lda #<pstart ;skips w/h
4590 sta r0
4600 lda #0 ; x bytes pos
4610 sta r1
4620 lda #16 ; y pixel pos
4630 sta r1+1
4640 lda pload ;width (at least 1)
4650 beq badmap ;not valid photo-might be the photo name strings
4660 cmp #40
4670 bcs badmap ;too wide
4680 sta r2
4690 lda pdepth ;height lo-byte only
4700 beq badmap ;not valid
4710 cmp #184
4720 bcs badmap ;too long
4730 sta r2+1
4740 jsr $c142 ;bitmapup (cbox)
4750 rts
4760 badmap =*
4770 jsr $c1ae ; i-putstring
4780 .word 110
4790 .byte 102
4800 .asc " -bad bitmap- "
4810 .byte 0
4820 rts
4830 ;----
4840 ; when exiting a db, this rtn is called twice
4850 ; to recover the db shadow & the db
4860 recovr =* ;called through $84b1
4870 lda rvflag
4880 bne norcvr ;call once
4890 lda #1
4900 sta rvflag
4910 jsr dogrid
4920 lda erflag
4930 bne nobmap ;is there a bitmap
4940 jsr drawph ;then display it
4950 nobmap =*
4960 rts
4970 norcvr =* ;reset on 2nd call
4980 lda #0
4990 sta rvflag
5000 rts
5010 rvflag .byte 0
5020 ;
5030 ;
5040 ;--- disk routines ---
5050 recnum .byte 0
5060 ;opendrive =* ;optional
5070 ;lda #8 ; drive
5080 ;jsr setdevice
5090 getrec =*
5100 jsr dogrid
5110 jsr $c2a1 ;opendisk (opndsk)
5120 lda #<phname ;name of album
5130 sta r0
5140 lda #>phname
5150 sta r0+1
5160 jsr $c274 ;openrecordfile (vopen)
5170 txa ;x=0 if no error
5180 beq grc1
5190 jsr derror
5200 rts
5210 grc1 =*
5220 lda recnum
5230 jsr $c280 ;pointrecord (goto)
5240 tya
5250 bne grc2 ;0 if empty
5260 jsr norec
5270 rts ;rec empty
5280 grc2 =*
5290 ; ok, now read it in
5300 lda #$15 ; max # of bytes (=sbegin-pload)
5310 sta r2+1
5320 lda #$d0
5330 sta r2
5340 lda #>pload ; load to address
5350 sta r7+1
5360 lda #<pload
5370 sta r7
5380 jsr $c28c ;readrecord (vload)
5390 ; .x hold error #
5400 txa
5410 beq grc3
5420 jsr derror
5430 rts
5440 grc3 =*
5450 ;r7=addr of first byte following the last byte read in
5460 lda r7 ;we'll use a4 as a pointer
5470 sta a4 ;(r7 is destroyed, a4 is reserved for our use)
5480 lda r7+1
5490 sta a4+1
5500 lda #0
5510 sta erflag ;if it (NULL)t this far!
5520 jsr drawph
5530 jsr $c277 ;closerecordfile (vclose)
5540 rts
5550 ;-----------------
5560 pcount .byte 0
5570 recbyt =*
5580 ; photo loaded at pload to the addr in a4 -1
5590 ; the bytes file will be saved from sbegin to a3
5600 ; set up a2 (photo pointer) & a3 (bytes pointer)
5610 lda #<pload
5620 sta a2
5630 lda #>pload
5640 sta a2+1
5650 lda #<sbegin
5660 sta a3
5670 lda #>sbegin
5680 sta a3+1
5690 ldy #0
5700 sty pcount
5710 xbyt1 =* ;loop
5720 lda pcount
5730 and #$0f
5740 bne xbyt2 ; every 16 bytes, start a new line
5750 lda #13 ;eol
5760 jsr addchr
5770 lda #46 ;period
5780 jsr addchr
5790 lda #66 ;b
5800 jsr addchr
5810 lda #89 ;y
5820 jsr addchr
5830 lda #84 ;t
5840 jsr addchr
5850 lda #32 ;spc
5860 jsr addchr
5870 jmp xbyt3
5880 ;
5890 xbyt2 =* ;use a comma
5900 lda #44
5910 jsr addchr
5920 xbyt3 =*
5930 inc pcount
5940 lda (a2),y ;index into photo file
5950 jsr bythex
5960 jsr inca2
5970 jsr cmpa24 ;done yet
5980 bcc xbyt1
5990 lda #13
6000 jsr addchr
6010 lda #13
6020 sta (a3),y
6030 lda #<sbegin ;save start in header
6040 sta sstart
6050 lda #>sbegin
6060 sta sstart+1
6070 lda a3 ;save end in header
6080 sta seqend
6090 lda a3+1
6100 sta seqend+1
6110 rts
6120 ;
6130 ; translate a byte into hex format
6140 bythex pha ; save byte
6150 lda #36
6160 jsr addchr
6170 pla
6180 pha
6190 lsr ; move hi-nybble into low
6200 lsr
6210 lsr
6220 lsr
6230 jsr fndasc ;returns with ascii char in .a
6240 jsr addchr ;write it to buffer
6250 pla ;get original byte
6260 jsr fndasc
6270 jsr addchr ;write it
6280 rts
6290 ;----
6300 fndasc =*;  returns ascii for 4 lsb in .a
6310 and #$0f ;clear 4 hibits
6320 cmp #$0a ; >9 print
6330 bmi find1
6340 adc #$06 ; it's a-f ; +$36
6350 find1 =*; if it's 0-9, add $30 to convert to ascii
6360 adc #$30
6370 rts
6380 ;
6390 addchr =*; add char in .a to the byte (file) buffer
6400 sta (a3),y
6410 jsr inca3
6420 rts
6430 ;
6440 inca2 inc a2
6450 bne xia2
6460 inc a2+1
6470 xia2 rts
6480 ;
6490 inca3 inc a3
6500 bne xia3
6510 inc a3+1
6520 xia3 rts
6530 ;
6540 cmpa24 =*
6550 ; if a2 >or= a4 then we've exceeded the eof so set .carry
6560 ; if < then return with .carry clear
6570 ;
6580 sec
6590 lda a2
6600 sbc a4
6610 sta xxtemp
6620 lda a2+1
6630 sbc a4+1
6640 ora xxtemp ;flags set
6650 rts
6660 ;
6670 xxtemp .byte 0
6680 ;
6690 ;-------
6700 savseq =*
6710 lda #<header ;header block for file
6720 sta r9
6730 lda #>header
6740 sta r9+1
6750 lda #0
6760 sta r10
6770 jsr $c1ed ;savefile (save)
6780 rts
6790 ;
6800 ;--- icon graphics ---
6810 iconex =* ;exit icon
6820 .byte 160,255,255,0,0,255,255,128,1,128,1,128,1
6830 .byte 143,241,143,241,143,241,128,1,128
6835 .byte 1,128,1,255,255,0,0,255,255,0,0
6840 ; the icons below were "grabbed"
6850 ; with an earlier version of this
6860 ; program.
6870 iconch =* ;choose icon
6880 .byte$05,$ff,$82,$fe,$80,$04,$00,$82
6885 .byte $03,$80,$04,$00,$b8,$03,$8f,$98
6890 .byte $00,$00,$00,$03,$98,$d8,$00,$00
6895 .byte $00,$03,$98,$1f,$1e,$3c,$78,$f3
6900 .byte $98,$1d,$b3,$66,$cd,$9b,$98,$19
6905 .byte $b3,$66,$c1,$9b,$98,$19,$b3,$66
6910 .byte $79,$fb,$98,$19,$b3,$66,$0d,$83
6915 .byte $98,$d9,$b3,$66,$cd,$9b,$8f,$99
6920 .byte $9e,$3c,$78,$f3,$80,$04,$00,$82
6925 .byte $03,$80,$04,$00,$81,$03,$06,$ff
6930 .byte $81,$7f,$05,$ff
6940 ;
6950 iconsa =* ;save icon
6960 .byte $05,$ff,$82,$fe,$80,$04,$00,$82
6965 .byte $03,$80,$04,$00,$b8,$03,$80,$1f
6970 .byte $00,$00,$00,$03,$80,$31,$80,$00
6975 .byte $00,$03,$80,$30,$1e,$66,$78,$03
6980 .byte $80,$30,$33,$66,$cc,$03,$80,$1f
6985 .byte $1f,$66,$cc,$03,$80,$01,$b3,$3c
6990 .byte $fc,$03,$80,$01,$b3,$3c,$c0,$03
6995 .byte $80,$31,$b3,$18,$cc,$03,$80,$1f
7000 .byte $1f,$18,$78,$03,$80,$04,$00,$82
7005 .byte $03,$80,$04,$00,$81,$03,$06,$ff
7010 .byte $81,$7f,$05,$ff
7020 ;
7030 larrow =* ;left arrow icon
7040 .byte $b0,$ff,$ff,$ff,$80,$00,$03,$80
7045 .byte $00,$03,$80,$00,$03,$80,$40,$03
7050 .byte $81,$c0,$03,$87,$ff,$f3,$9f,$ff
7055 .byte $f3,$87,$ff,$f3,$81,$c0,$03,$80
7060 .byte $40,$03,$80,$00,$03,$80,$00,$03
7065 .byte $80,$00,$03,$ff,$ff,$ff,$7f,$ff,$ff
7070 ;
7080 rarrow =* ;right arrow icon
7090 .byte $b0,$ff,$ff,$fe,$80,$00,$03,$80
7095 .byte $00,$03,$80,$00,$03,$80,$04,$03
7100 .byte $80,$07,$03,$9f,$ff,$c3,$9f,$ff
7105 .byte $f3,$9f,$ff,$c3,$80,$07,$03,$80
7110 .byte $04,$03,$80,$00,$03,$80,$00,$03
7115 .byte $80,$00,$03,$ff,$ff,$ff,$7f,$ff,$ff
7120 ;
7130 permnm =*  ;find any version
7140 ;.asc "photo album "
7141 .byte $70,$68,$6f,$74,$6f,$20,$61,$6c,$62,$75,$6d,$20
7150 .byte 0 ;(version not included)
7160 ;  the new photo album (v2.1) stores the
7170 ;  names of the individual photos as the
7180 ;  last used record.
7190 ;  use: .asc "photo album v1.0"
7200 ;  to read the older versions exclusively.
7210 ;  use: .asc "photo album v2.1"
7220 ;  to read the newer version.
7230 ;
7240 phname .byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;selected photo album
7250 svname .byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;user entered name
7260 ;---------------------------
7270 ; this header is saved along with the file
7280 header =*
7290 .wor svname
7300 .byte 3,21 ,$bf ; 3x21 icon
7310 .byte $ff,$ff,$ff,$80,0,1,$80,0,1,$80
7315 .byte 0,1,$80,0,1,$80,0,1,$80,0,1,$80,0,1
7320 .byte $80,0,1,$80,0,1,$80,0,1,$80,0,1,$80
7325 .byte 0,1,$80,0,1,$80,0,1,$80,0,1,$80,0,1
7330 .byte $80,0,1,$80,0,1,$80,0,1,$ff,$ff,$ff
7335 ;this icon is just a square outline
7340 ; save the file as a c= seq
7350 .byte $81 ;  c= seq
7360 ; actually, when the kernal writes
7370 ; the file to disk, it wont save
7380 ; the header to disk
7390 ; when it sees the next
7400 ; byte, a filetype of non-geos.
7410 .byte 0 ; non-geos/alternately use 3 for data
7420 .byte 0 ; geos seq
7430 ; next two words placed by translate rtn
7440 sstart =*
7450 .wor 0 ; start addr
7460 seqend =*
7470 .wor 0,0 ; end addr, jump addr
7480 .asc "icon definerv1.0"
7490 .byte 0,0,0,0
7500 ;
7510 .asc "f. g. kostella  "
7520 .byte 0,0,0,0
7530 ;
7540 *=*+139
7550 endcod =* ;specified in header
7560 .end