home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 3 / FREEWARE.BIN / towns_os / pmgf / src / pmgfld_m.bas < prev    next >
BASIC Source File  |  1980-01-02  |  3KB  |  64 lines
  1. 9000 *PMGF
  2. 9010 HEAD$="PMGf":VERN=1:MOUSE 5
  3. 9020 ON ERROR GOTO *L_ERR:OPEN "I",#1,ID$+I$+".PGF":ON ERROR GOTO 0
  4. 9030 A$=INPUT$(4,1):IF A$<>HEAD$ THEN END
  5. 9040 A=ASC(INPUT$(1,1)):IF A<>VERN THEN END
  6. 9050 X=CVI(INPUT$(2,1)):Y=CVI(INPUT$(2,1)):BIT=ASC(INPUT$(1,1)):PALM=ASC(INPUT$(1,1)):MASKM=ASC(INPUT$(1,1)):DUM$=INPUT$(2,1):BITL=ASC(INPUT$(1,1)):DUM$=INPUT$(1,1):HEL&=16
  7. 9060 IF BIT=1 OR BIT=4 THEN SCM=0 ELSE IF BIT=8 THEN SCM=2 ELSE SCM=1
  8. 9070 GOSUB *SCREEN_MODE:GOSUB *PALETTE_CHANGE:MHEL&=HEL&
  9. 9080 IF (MASKM AND 128)=128 THEN MLLN&=CVL(INPUT$(4,1)):HEL&=HEL&+MLLN&+16
  10. 9090 CLOSE #1:GOSUB *GET_FILE:FAD&=VARPTR(FB%(0))+HEL&
  11. 9100 X2=X1+X-1:Y2=Y1+Y-1:IF (MASK AND MASKM AND 1)=0 THEN *MASK_CHK
  12. 9110 A=0:IF BIT=1 THEN GOSUB *MONO:GOTO *MASK_CHK ELSE GOSUB *MAIN:GOTO *MASK_CHK
  13. 9120 *MAIN:FOR C=Y1 TO Y2
  14. 9130  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  15. 9140  DL&=CALLM(0,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  16. 9150  FAD&=FAD&+DL&
  17. 9160  PUT@A (X1,C)-(X2,C),GM%
  18. 9170  A=A+1:IF A>7 THEN A=0
  19. 9180 NEXT:RETURN
  20. 9190 *MONO
  21. 9200 FOR C=Y1 TO Y2
  22. 9210  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  23. 9220  DL&=CALLM(0,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  24. 9230  FAD&=FAD&+DL&
  25. 9240  PUT@ (X1,C)-(X2,C),GM%,PSET,%MPC
  26. 9250  A=A+1:IF A>7 THEN A=0
  27. 9260 NEXT:RETURN
  28. 9270 *OBJE:FOR C=Y1 TO Y2
  29. 9280  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  30. 9290  DL&=CALLM(0,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  31. 9300  FAD&=FAD&+DL&
  32. 9310  PUT@A (X1,C)-(X2,C),GM%,OR
  33. 9320  A=A+1:IF A>7 THEN A=0
  34. 9330 NEXT:RETURN
  35. 9340 *MASK_CHK
  36. 9350 IF (MASK AND MASKM AND 128)=0 THEN *ALL_END
  37. 9360 FAD&=VARPTR(FB%(0))+MHEL&+4:MOX=FNCV(FAD&):MOY=FNCV(FAD&+2):X=FNCV(FAD&+4):Y=FNCV(FAD&+6):MBITL=PEEK(FAD&+8):OBITL=PEEK(FAD&+9):FAD&=FAD&+12
  38. 9370 X1=MOX:X2=X1+X-1:Y1=MOY:Y2=Y1+Y-1:BITL=MBITL:OBIT=1:SWAP BIT,OBIT:LLN=(X+7)\8:MPC=0:A=0:GOSUB *MONO:SWAP BIT,OBIT:BITL=OBITL:GOSUB *CALC_LLN:A=0:GOSUB *OBJE
  39. 9380 *ALL_END:ERASE FB%:GOSUB *MOS_INI:RETURN
  40. 9390 *PAL_INI:IF SCM=1 THEN RETURN ELSE IF SCM=2 THEN 9410
  41. 9400 RESTORE 9420:FOR A=0 TO 15:READ PAL&(A):NEXT:FOR A=16 TO 255:PAL&(A)=0:NEXT:A&=16:RETURN
  42. 9410 A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:PAL&(A)=(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)):A=A+1:NEXT:NEXT:NEXT:A&=256:RETURN
  43. 9420 DATA 0,128,32768,32896,8388608,8388736,8421376,8421504,4210752,255,65280,65535,16711680,16711935,16776960,16777215
  44. 9430 *ERROR:GOSUB *PAL_INI:ON ERROR GOTO 0:RESUME 9040
  45. 9440 *L_ERR:PRINT "指定のファイルは見つかりませんでした。":END
  46. 9450 *SCREEN_MODE:SCREEN@ SCM:IF SCM=1 THEN WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255) ELSE WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511)
  47. 9460 IF BIT=1 THEN LLN=(X+7)\8:RETURN
  48. 9470 *CALC_LLN:IF BIT=4 THEN LLN=((X+7)\8)*4:RETURN
  49. 9480 IF BIT=8 THEN LLN=X:RETURN
  50. 9490 IF BIT=16 THEN LLN=X*2:RETURN
  51. 9500 *PALETTE_CHANGE:IF PALM=0 THEN *PAL_INI ELSE GOSUB *PAL_GET
  52. 9510 FOR A=0 TO DL:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  53. 9520 *PAL_GET:IF SCM=2 THEN 9540
  54. 9530 FOR A=0 TO 15:A$=INPUT$(1,1):B$=INPUT$(1,1):PAL&(A)=((ASC(A$)*65536)+(ASC(B$) AND &HF0)*16+(ASC(B$) AND 15))*16:NEXT:DL=15:HEL&=HEL&+(DL+1)*2:RETURN
  55. 9540 FOR A=0 TO 255:A$=CHR$(0)+INPUT$(3,1):PAL&(A)=CVL(A$):NEXT:DL=255:HEL&=HEL&+(DL+1)*3:RETURN
  56. 9550 *GET_FILE:F_F$=I$+".PGF":GOSUB *FILESIZE:LOAD@ ID$+I$+".PGF",FB%:RETURN
  57. 9560 *FILESIZE
  58. 9570  F_D$=ID$
  59. 9580  OPEN "R",#3,F_D$+"(1)"+F_F$
  60. 9590  F_SI&=LOF(3)
  61. 9600  CLOSE #3
  62. 9610 DIM FB%(CLNG(F_SI&/2+.5!)-2)
  63. 9620 RETURN
  64.