正方形変換

 投稿者:しばっち  投稿日:2015年 5月30日(土)22時03分18秒
  !' 正方形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'正方形変換
!' X'=A*(X/A)^2
!' Y'=A*(Y/A)^2
!'逆変換
!' X=SQR(A)*SQR(X')
!' Y=SQR(A)*SQR(Y')
CLEAR
LET MODE=0
SELECT CASE MODE
CASE 0
   FOR YS=0 TO YSIZE-1
      LET Y=YS-YSIZE/2
      FOR XS=0 TO XSIZE-1
         LET X=XS-XSIZE/2
         LET XX=SQR(XSIZE/2)*SQR(ABS(X))*SGN(X)
         LET YY=SQR(YSIZE/2)*SQR(ABS(Y))*SGN(Y)
         IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
            LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
            CALL RGB(C,R,G,B)
            CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
         END IF
      NEXT  XS
   NEXT  YS
CASE 1
   FOR YS=0 TO YSIZE-1
      LET Y=YS-YSIZE/2
      FOR XS=0 TO XSIZE-1
         LET X=XS-XSIZE/2
         LET XX=X
         LET YY=SQR(YSIZE/2)*SQR(ABS(Y))*SGN(Y)
         IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
            LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
            CALL RGB(C,R,G,B)
            CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
         END IF
      NEXT  XS
   NEXT  YS
CASE 2
   FOR YS=0 TO YSIZE-1
      LET Y=YS-YSIZE/2
      FOR XS=0 TO XSIZE-1
         LET X=XS-XSIZE/2
         LET XX=SQR(XSIZE/2)*SQR(ABS(X))*SGN(X)
         LET YY=Y
         IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
            LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
            CALL RGB(C,R,G,B)
            CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
         END IF
      NEXT  XS
   NEXT  YS
END SELECT
END

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
 
 

戻る