#11 Article 1122 Posted at 1988/02/20 20:00:17 by Wa! (MAP609) [PRG.WML]
Subject: WMLoader for FM-11
PROCEDURE WMLoader
(* WMLoader Ver 1.1
(* for BASIC09
(* 200/400 Line & 7/8 bit
(*
(* by Wa!
PARAM prm:STRING[32]
BASE 0
TYPE Blk=pt,path,pcl,init:BYTE; py,px:INTEGER; fdt,fgetbc,fb,dtl:BYTE; dt:INTEGER
DIM DatBlk:Blk
DIM d(41):INTEGER
DIM x0,x1,y,yg,YMAX:INTEGER
DIM c,lin,ls:INTEGER
DIM packtype,fp:BYTE
DIM fn:STRING[32]
DIM mode:STRING[1]
ON ERROR GOTO 99
IF prm="" THEN
PRINT " ** WMLoader **"
PRINT " for BASIC09"
PRINT
INPUT "filename :",fn
ELSE
fn:=prm
ENDIF
c:=SUBSTR(".WM",fn)
IF c<=2 THEN
ERROR 215
ELSE
lin:=VAL(MID$(fn,c+3,1))
IF lin<>2 AND lin<>4 THEN ERROR 56 \ ENDIF
mode:=MID$(fn,c+4,1)
IF mode="b" OR mode="B" THEN
DatBlk.init:=8
ELSE
DatBlk.init:=7
ENDIF
ENDIF
OPEN #fp,fn:READ
RUN Cls
RUN Locate(0,0,0)
YMAX:=399
ls=(6-lin)/2 \(* lin=2 - ls=2 : lin=4 - ls=1 *)
DatBlk.path:=fp
c:=1 \ GOSUB 30 \ FOR y:=0 TO YMAX STEP ls \ GOSUB 10 \NEXT y
c:=2 \ GOSUB 30 \ FOR y:=0 TO YMAX STEP ls \ GOSUB 10 \NEXT y
c:=4 \ GOSUB 30 \ FOR y:=0 TO YMAX STEP ls \ GOSUB 10 \NEXT y
CLOSE #fp
GET #0,fp
RUN Locate(0,0,1)
END
(* draw 1 line
(*
10 RUN WML_Subr(0,DatBlk)
packtype:=DatBlk.pt
DatBlk.py:=y
RUN WML_Subr(1,DatBlk)
ON packtype GOSUB 11,12,13,14,15,16,17
IF lin=2 THEN
x0:=0 \x1:=639 \yg:=y \ GOSUB 20
RUN Put1(0,y+1,639,y+1,d,c,2)
ENDIF
RETURN
11 yg:=y-1*ls \x0:=0 \x1:=639 \ GOSUB 20 \RUN Put1(0,y,639,y,d,c,4) \ RETURN
12 yg:=y-2*ls \x0:=0 \x1:=639 \ GOSUB 20 \RUN Put1(0,y,639,y,d,c,4) \ RETURN
13 yg:=y-3*ls \x0:=0 \x1:=639 \ GOSUB 20 \RUN Put1(0,y,639,y,d,c,4) \ RETURN
14 yg:=y-4*ls \x0:=0 \x1:=639 \ GOSUB 20 \RUN Put1(0,y,639,y,d,c,4) \ RETURN
15 yg:=y-1*ls \x0:=0 \x1:=638 \ GOSUB 20 \RUN Put1(1,y,639,y,d,c,4) \ RETURN
16 yg:=y-1*ls \x0:=0 \x1:=637 \ GOSUB 20 \RUN Put1(2,y,639,y,d,c,4) \ RETURN
17 yg:=y-1*ls \x0:=1 \x1:=639 \ GOSUB 20 \RUN Put1(0,y,638,y,d,c,4) \ RETURN
(* GET@
(*
20 IF c=1 THEN RUN Get1(x0,yg,x1,yg,d,1,3,5,7)
ELSE IF c=2 THEN RUN Get1(x0,yg,x1,yg,d,2,3,6,7)
ELSE IF c=4 THEN RUN Get1(x0,yg,x1,yg,d,4,5,6,7)
ENDIF \ ENDIF \ ENDIF
RETURN
(* initialize for 1 screen
(*
30 DatBlk.pcl:=c
DatBlk.fgetbc:=0
RETURN
99 c:=ERR
RUN Locate(0,0,1)
ON ERROR
ERROR c
END