M-Treasure (Medic Program)

[RWAP]

I have a different version of M-Treasure (written by Janko Mrsic Flogel) to the version of 'Treasure' on the Sinclair QL Homepage.

Dilwyn - I don't think Medic ever surrendered their rights to this program - after their demise, the rights probably belong to Janko (if anyone can get him to respond!)

The version on the Sinclair QL Homepage is corrupt (look at the ghosts on the first level).

The version I have works, but needs Toolkit II in the boot program (attached) - anyone fancy re-writing the EOR function to get it to work in normal SuperBASIC...

Code: Select all

1 MODE 4:GO SUB 12
2 WINDOW 512,256,0,0:PAPER 0:CLS:POKE 98403,8
3 a2=R:POKE_L a2,eor('f4d812e5',PEEK_L(a2))
4 POKE_L a2,eor('f57748dc',PEEK_L(a2)):a2=a2+4
5 POKE_L a2,eor('f4dbc357',PEEK_L(a2)):a2=a2+4
6 a2=a2+HEX('30')
7 POKE_L a2,eor('d35569bc',PEEK_L(a2))
8 OPEN #1,scr_:OPEN #2,con_448x180a32x16
9 FOR i=1 TO 1000:NEXT i
10 CALL R,0,0,-1,187696,0,199600,0,R,a2,0,-1,199600,HEX('100'),0
11 FOR a=1 TO 1.234567E6:REMark 
12 OPEN #10,SCR_370X170A70X60:CSIZE#10,1,1
13 OPEN #1,scr_2x2a0x0
14 BORDER#10,1,0:PAPER#10,7:INK#10,0
15 inp_ch=6:Pull_ch=7:err_ch=8:dir_ch=9:dev_ch=12:temp_ch=11:whole_ch=3
16 beep_len=10000:beep_pitch=10:is_inv_inp_ch=0
17 IF PEEK(163890):maincol=4:ELSE maincol=224
18 GLx=0:GLy=20:dev_y=30:dev_x=150
19 OPEN #4,con_:OPEN #whole_ch,scr_512x256a0x0:PAPER #whole_ch,0,4,3
20 OPEN #5,scr_512x100a0x100:PAPER #5,4:INK #5,7
21 OPEN #inp_ch,scr_470x12a20x236:PAPER #inp_ch,7:INK #inp_ch,0
22 OPEN #err_ch,scr_470x12a20x220:OPEN #Pull_ch,scr_
23 OPEN #dir_ch,scr_512x206a0x20:PAPER #dir_ch,2:INK #dir_ch,7
24 OPEN #dev_ch,scr_512x206a0x20:PAPER #dev_ch,2:INK #dev_ch,7:OPEN #temp_ch,scr_
25 REPeat whole
26 CLS#whole_ch
27 WINDOW#4,470,25,20-5,8+5:BORDER#4,0,0:PAPER#4,0:CLS#4
28 WINDOW#4,470,25,20,8:BORDER#4,2,7:PAPER#4,2:CLS#4
29 WINDOW#inp_ch,470,12,20-4,236+4:BORDER#inp_ch,0,0:PAPER#inp_ch,0:CLS#inp_ch
30 WINDOW#inp_ch,470,12,20,236:BORDER#inp_ch,1,0:PAPER#inp_ch,7:INK#inp_ch,0:CLS#inp_ch
31 CSIZE#4,3,1:BORDER#10,0,1
32 RESTORE 32767:count%=1:y=20:CSIZE#4,3,1
33 OPEN #10,SCR_470X170A15X55:PAPER#10,0:CLS#10
34 WINDOW#10,470,170,20,50:PAPER#10,7:CSIZE#10,1,0
35 BORDER#10,1,1:INK#10,0:CLS#10:INK#4,7
36 CLS#6
37 CLS#10:CSIZE#10,3,1:AT#10,3,4: PRINT#10," LOADING M-TREASURE."
38 CSIZE#10,1,0:AT#10,15,14:PRINT#10,"(C) Medic Datasystems Limited."
39 R=RESPR(49000):LBYTES flp1_CODE,R:POKE_L 131072,R:RETurn 
40 DEFine FuNction eor(x$,s)
41 c$=BIN$(s,32):x$=BIN$(HEX(x$),32)
42 b$=FILL$('0',32)
43 FOR a=1 TO 32
44 IF (c$(a)='1' AND x$(a)='0') OR (c$(a)='0' AND x$(a)='1'):b$(a)='1'
45 END FOR a
46 RETurn BIN(b$)
47 END DEFine 

[tofro]

The version I have works, but needs Toolkit II in the boot program (attached) - anyone fancy re-writing the EOR function to get it to work in normal SuperBASIC...

Rich,
how does

Code: Select all

40 DEFine FuNction eor(x$,s)
41 RETurn x$^^s
47 END DEFine 

look?


(It does assume the hexadecimal constants used as input are converted to decimal first)

Tobias

[tofro]

Untested:

Code: Select all

    1 MODE 4:GO SUB 12
    2 WINDOW 512,256,0,0:PAPER 0:CLS:POKE 98403,8
    3 a2=R:POKE_L a2,eor(4107801317,PEEK_L(a2))
    4 POKE_L a2,eor(4118235356,PEEK_L(a2)):a2=a2+4
    5 POKE_L a2,eor(4108043095,PEEK_L(a2)):a2=a2+4
    6 a2=a2+48
    7 POKE_L a2,eor(3545590204,PEEK_L(a2))
    8 OPEN #1,scr_:OPEN #2,con_448x180a32x16
    9 FOR i=1 TO 1000:NEXT i
    10 CALL R,0,0,-1,187696,0,199600,0,R,a2,0,-1,199600,256,0
    11 FOR a=1 TO 1.234567E6:REMark
    12 OPEN #10,SCR_370X170A70X60:CSIZE#10,1,1
    13 OPEN #1,scr_2x2a0x0
    14 BORDER#10,1,0:PAPER#10,7:INK#10,0
    15 inp_ch=6:Pull_ch=7:err_ch=8:dir_ch=9:dev_ch=12:temp_ch=11:whole_ch=3
    16 beep_len=10000:beep_pitch=10:is_inv_inp_ch=0
    17 IF PEEK(163890):maincol=4:ELSE maincol=224
    18 GLx=0:GLy=20:dev_y=30:dev_x=150
    19 OPEN #4,con_:OPEN #whole_ch,scr_512x256a0x0:PAPER #whole_ch,0,4,3
    20 OPEN #5,scr_512x100a0x100:PAPER #5,4:INK #5,7
    21 OPEN #inp_ch,scr_470x12a20x236:PAPER #inp_ch,7:INK #inp_ch,0
    22 OPEN #err_ch,scr_470x12a20x220:OPEN #Pull_ch,scr_
    23 OPEN #dir_ch,scr_512x206a0x20:PAPER #dir_ch,2:INK #dir_ch,7
    24 OPEN #dev_ch,scr_512x206a0x20:PAPER #dev_ch,2:INK #dev_ch,7:OPEN #temp_ch,scr_
    25 REPeat whole
    26 CLS#whole_ch
    27 WINDOW#4,470,25,20-5,8+5:BORDER#4,0,0:PAPER#4,0:CLS#4
    28 WINDOW#4,470,25,20,8:BORDER#4,2,7:PAPER#4,2:CLS#4
    29 WINDOW#inp_ch,470,12,20-4,236+4:BORDER#inp_ch,0,0:PAPER#inp_ch,0:CLS#inp_ch
    30 WINDOW#inp_ch,470,12,20,236:BORDER#inp_ch,1,0:PAPER#inp_ch,7:INK#inp_ch,0:CLS#inp_ch
    31 CSIZE#4,3,1:BORDER#10,0,1
    32 RESTORE 32767:count%=1:y=20:CSIZE#4,3,1
    33 OPEN #10,SCR_470X170A15X55:PAPER#10,0:CLS#10
    34 WINDOW#10,470,170,20,50:PAPER#10,7:CSIZE#10,1,0
    35 BORDER#10,1,1:INK#10,0:CLS#10:INK#4,7
    36 CLS#6
    37 CLS#10:CSIZE#10,3,1:AT#10,3,4: PRINT#10," LOADING M-TREASURE."
    38 CSIZE#10,1,0:AT#10,15,14:PRINT#10,"(C) Medic Datasystems Limited."
    39 R=RESPR(49000):LBYTES flp1_CODE,R:POKE_L 131072,R:RETurn
    40 DEFine FuNction eor(x,s)
    41 RETurn x^^s
    47 END DEFine

Removed anything that looked like TK2.
The program looks weird in places (like RESTORE with no DATA)

But maybe you want to give it a try,

Tobias

[RWAP]

Unfortunately, you get an overflow - it doesn't help that QDOS cannot handle a number of 4107801317 (for example) in full, but the RETURN a^^b gives an overflow .....

[tofro]

Maybe something like that works, then (breaks the float into two word-sized bits, does the xor and patches the two words back into a float:

Code: Select all

DEFfn eor(x,y)
LOCal upper1, lower1, upper2, lower2
upper1 = INT(x / 65536)
lower1 = x-(upper1 * 65536)
upper2 = INT(y / 65536)
lower2 = y-(upper2 * 65536)
return (upper1^^upper2)*65536+(lower1^^lower2)

[RWAP]

Of course, the simplest solution is something no-one has proposed yet....

[Dave]

VisualBASIC?

[RWAP]

Hmm - visual basic - a sledgehammer to knock in a pin?

You would end up with a program several MB in size, no good for a Basic QL

There is a much simpler solution if you actually look at the boot program...

[Dave]

No clue.

My only observation was that the program would run a lot faster if the defined function that is used most was put at the beginning of the listing.

[tofro]

Well, if you're not looking for a xor-solution for long integers (which i guess you don't), you can rewrite the program to peek and poke bytes or words instead of longwords and get by with the QL's integer math.

But it was YOU who wanted the eor() function re-written

Tobias