The Sinclair QL Forum

RIP Sir Clive Sinclair 1940 - 2021
https://theqlforum.com/

M-Treasure (Medic Program)

https://theqlforum.com/viewtopic.php?t=984

Page 1 of 2

M-Treasure (Medic Program)

Posted: Thu May 29, 2014 3:29 pm
by 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

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 4:44 pm
by tofro
RWAP wrote: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

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 5:00 pm
by 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

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 5:43 pm
by 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 .....

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 5:53 pm
by 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)

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 8:52 pm
by RWAP
Of course, the simplest solution is something no-one has proposed yet.... :D

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 9:17 pm
by Dave
VisualBASIC? :)

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 9:25 pm
by 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 :lol:

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

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 9:31 pm
by 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.

Re: M-Treasure (Medic Program)

Posted: Thu May 29, 2014 9:44 pm
by 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 :D

Tobias
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited