New Draw Module

Amarylis · **Posted:** Thu May 10, 2012 4:12 pm

...Open Turing, with some slight modifications done by yours truly.

copthesaint · **Posted:** Thu May 10, 2012 4:27 pm

@Dreadnought, You have to use version 4.0.5 and It will work. make sure the splash screen says 4.0.5 when you open turing. I am not using openturing.

Amarylis · **Posted:** Thu May 10, 2012 4:30 pm

I know you are not- Dreadnought asked which version I was using Razz

copthesaint · **Posted:** Thu May 10, 2012 6:27 pm

Well I am posting an update, right now the image capture works awsome! With certain exceptions, that if not meant will cause bugs atm. Currently I have found these bugs:

#1 "Not divisible by 8 error": If the image is not divisable by 8, my program like to report error: Array subscript is out of range line 92 when getting the values.

#2 "Height greater then width run-time error": If the image has a height greater then the width then the image crops its self from the bottom up until the height - difference = width.

I am please though at how well it works, and how fast it works.

Turing:

type Pixel :
record
CLR : array 1 .. 3 of int2
Alpha : real4
end record

type Buffer :
record
RGB : Pixel
Depth : int1
end record

class Layer
import Pixel, Buffer
export Resize, LoadLayerFile, SaveLayerFile, Capture, Display, Scale, Clear, Transparency, Invert, ColorBack, TransparencyNoColor, ColorBackRed, ColorBackGreen,
ColorBackBlue, BlackWhite, FilterColor, Depth, DrawDot, DrawOval, DrawArc

const TransperentColor : int1 := 0
const maxColor : int := 255 shl 0| 255 shl 8| 255 shl 16| 255 shl 24
const LayerFileExtension : string := "lbm"
var widthLayer, heightLayer : int2 := 0
var posXLayer, posYLayer : int2 := 0
var scale : int2 := 0
var depth : int1 := 0
var layer : flexible array 1 .. 0 of Buffer
var layerBoundSize : int := 0

function GetColors (x : int) : array 0 .. 3 of int
var resultingValue : array 0 .. 3 of int %The Color values.
var y : nat := 0
if x < 0 then
y := (maxnat) & (x)
else
y := x
end if

%A temp variable to hold the value sent from the bitmap
for i : 0 .. 3 %for all 4 values
resultingValue (3 - i) := y shr ((3 - i) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (resultingValue (3 - i) shl ((3 - i) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for % end for
if y = 0 then
result resultingValue
end if
end GetColors

procedure Resize (x, y : int)
widthLayer := x
heightLayer := y
layerBoundSize := widthLayer * heightLayer
var tempSize : int := upper (layer)
if layerBoundSize > upper (layer) then
new layer, layerBoundSize
end if
for i : tempSize + 1 .. upper (layer)
layer (i).RGB.CLR (1) := 0
layer (i).RGB.CLR (2) := 0
layer (i).RGB.CLR (3) := 0
layer (i).RGB.Alpha := 1
layer (i).Depth := 0
end for
end Resize

procedure SaveLayerFile (name : string)
var saveName : string := name + "." + LayerFileExtension

end SaveLayerFile

procedure LoadLayerFile (name : string)
var saveName : string := name + "." + LayerFileExtension
end LoadLayerFile

procedure Capture (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.CLR (imageColorShade) := tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for
end for

end Capture

procedure Display
cls
var b : array 1 .. sizepic (1, 1, widthLayer, heightLayer) of int
takepic (1, 1, widthLayer, heightLayer, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56 % why 56? it changes how the image is shifted when redrawn
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = layer (imageID).RGB.CLR (imageColorShade) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for

drawpic (posXLayer, posYLayer, b, 1)
delay (1)
var pic1 : int := Pic.New (posXLayer, posYLayer, posXLayer + widthLayer, posYLayer + heightLayer)
var pic2 : int := Pic.Scale (pic1, widthLayer * scale, heightLayer * scale)
Pic.Draw (pic1, posXLayer + widthLayer + 10, posXLayer, picCopy)
View.Update
Pic.Free (pic1)
Pic.Free (pic2)
end Display

procedure Clear
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := TransperentColor
layer (i).RGB.CLR (2) := TransperentColor
layer (i).RGB.CLR (3) := TransperentColor
end for
end Clear

procedure Scale (x : int2)
scale := x
end Scale

procedure Depth (x : int2)
depth := x
end Depth

procedure Transparency (x : real4)
for i : 1 .. upper (layer)
layer (i).RGB.Alpha := x
end for
end Transparency

procedure Invert
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := 255 - layer (i).RGB.CLR (1)
layer (i).RGB.CLR (2) := 255 - layer (i).RGB.CLR (2)
layer (i).RGB.CLR (3) := 255 - layer (i).RGB.CLR (3)
end for
end Invert

procedure TransparencyNoColor (x : real4)
for i : 1 .. upper (layer)
if layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3) = (TransperentColor * 3) then
layer (i).RGB.Alpha := x
end if
end for
end TransparencyNoColor

procedure ColorBack (R, G, B : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := R
layer (i).RGB.CLR (2) := G
layer (i).RGB.CLR (1) := B
end for
end ColorBack

procedure ColorBackRed (R : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := R
end for
end ColorBackRed

procedure ColorBackGreen (G : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (2) := G
end for
end ColorBackGreen

procedure ColorBackBlue (B : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := B
end for
end ColorBackBlue

procedure BlackWhite
var tempVal : int
for i : 1 .. upper (layer)
tempVal := (layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3)) div 3
layer (i).RGB.CLR (1) := tempVal
layer (i).RGB.CLR (2) := tempVal
layer (i).RGB.CLR (3) := tempVal
end for
end BlackWhite

procedure FilterColor (R, G, B : int, percent : real)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := round ((layer (i).RGB.CLR (3) * (1 - percent)) + (R * percent))
layer (i).RGB.CLR (2) := round ((layer (i).RGB.CLR (2) * (1 - percent)) + (G * percent))
layer (i).RGB.CLR (1) := round ((layer (i).RGB.CLR (1) * (1 - percent)) + (B * percent))
end for
end FilterColor

procedure DrawDot (x, y, R, G, B : int)
if x < widthLayer + 1 and x > 0 and y < heightLayer + 1 and y > 0 then
layer ((y - 1) * widthLayer + x).RGB.CLR (3) := R
layer ((y - 1) * widthLayer + x).RGB.CLR (2) := G
layer ((y - 1) * widthLayer + x).RGB.CLR (1) := B
end if
end DrawDot

procedure DrawOval (x, y, radX, radY, R, G, B : int)
var perimeter : real := 3.1415 * radX * radY
var angleInc : real := 360 / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (angleInc * i)), y + round (radY * sind (angleInc * i)), R, G, B)
end for
end DrawOval

procedure DrawArc (x, y, radX, radY : int, initA, finishA : real, R, G, B : int)
var perimeter : real := (finishA - initA) / 360 * 3.1415 * radX * radY
var angleInc : real := (finishA - initA) / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (initA + angleInc * i)), y + round (radY * sind (initA + angleInc * i)), R, G, B)
end for
end DrawArc

end Layer

class Render
import Layer

procedure AddLayer (layerX : pointer to Layer)

end AddLayer

procedure Color

end Color

procedure Update

end Update
end Render

View.Set ("Graphics:max;max,offscreenonly,nobuttonbar")

procedure Test1
var layer1 : pointer to Layer
new Layer, layer1
var pic1 : int := Pic.FileNew ("test4.bmp")
Pic.Draw (pic1, 1, 1, picCopy)
put Pic.Width (pic1), ":", Pic.Height (pic1)
View.Update
delay (1000)
layer1 -> Capture (1, 1, Pic.Width (pic1), Pic.Height (pic1))

cls
layer1 -> Scale (1)
layer1 -> Display
Pic.Draw (pic1, 1, 1, picCopy)
Pic.Free (pic1)
end Test1

Test1

copthesaint · **Posted:** Sun May 20, 2012 4:56 pm

I have run into another problem... for some reason picsize and takepic is not working in my Render Module... If anyone would know why, it would help Razz

I will keep trying until I get it to work but Im just not sure why it isnt working.

Turing:

type PixelValues :
record
CLR : array 1 .. 3 of int2
Alpha : real4
end record

type Pixel :
record
RGB : PixelValues
Depth : int1
end record

class Image
import Pixel, PixelValues, File
export ImageSize, ImageWidth, ImageHeight, Export, Save, Load, Capture, CaptureAlpha, Display, Depth, MergeAlphaLayer,

SetColor, Invert, Clear, AlphaBack, ColorBack, NoColorAlpha, ColorBackRed, ColorBackGreen, ColorBackBlue, BlackWhite, FilterColor,

DrawDot, DrawOval, DrawArc

const AutoOverwrite : boolean := true
const TransperentColor : int1 := 0
const LayerFileExtension : string := "lbm"
var widthLayer, heightLayer : int2 := 0
var posXLayer, posYLayer : int2 := 0
var setColor : PixelValues
var scale : int2 := 0
var depth : int1 := 0
var layer : flexible array 1 .. 0 of Pixel
var layerBoundSize : int := 0
setColor.CLR (1) := 0
setColor.CLR (2) := 0
setColor.CLR (3) := 0
setColor.Alpha := 0
/*
PRIVATE METHODS
*/
procedure Resize (x, y : int)
widthLayer := x
heightLayer := y
layerBoundSize := widthLayer * heightLayer
var tempSize : int := upper (layer)
if layerBoundSize > upper (layer) then
new layer, layerBoundSize
end if
for i : tempSize + 1 .. upper (layer)
layer (i).RGB.CLR (1) := 0
layer (i).RGB.CLR (2) := 0
layer (i).RGB.CLR (3) := 0
layer (i).RGB.Alpha := 1
layer (i).Depth := 0
end for
end Resize

function GetColors (x : int) : array 0 .. 3 of int
var resultingValue : array 0 .. 3 of int %The Color values.
var y : nat := 0 %A temp variable to hold the value sent from the bitmap
if x < 0 then
y := (maxnat) & (x)
else
y := x
end if

for i : 0 .. 3 %for all 4 values
resultingValue (3 - i) := y shr ((3 - i) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (resultingValue (3 - i) shl ((3 - i) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for % end for
if y = 0 then
result resultingValue
end if
end GetColors
/*
PUBLIC METHODS
*/
procedure Capture (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.CLR (imageColorShade) := tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for
end for
end Capture

procedure CaptureAlpha (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.Alpha := layer (imageID).RGB.Alpha + tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
layer (imageID).RGB.Alpha := ((layer (imageID).RGB.Alpha - 1) div 3) / 255
imageID := imageID + 1
end if
end for
end for
end CaptureAlpha

procedure Save (name : string)
var saveName : string := name + "." + LayerFileExtension
var fileStream : int := 0
if File.Exists (saveName) = true then
if AutoOverwrite then
File.Delete (saveName)
else
Error.Halt ("Auto Overide off, will implement other options later.")
end if
end if
open : fileStream, saveName, put
put : fileStream, intstr (layerBoundSize) + " " ..
put : fileStream, intstr (widthLayer) + " " ..
put : fileStream, intstr (heightLayer) + " " ..
var tempValue : nat := 0
for i : 1 .. layerBoundSize
tempValue := 0
for j : 1 .. 3
tempValue| = layer (i).RGB.CLR (j) shl ((j - 1) * 8)
end for
tempValue| = round (254 * layer (i).RGB.Alpha) shl 24
put : fileStream, natstr (tempValue) + " " ..
end for
close (fileStream)
end Save

procedure Load (name : string)
var loadName : string := name + "." + LayerFileExtension
var fileStream : int

if File.Exists (loadName) = true then
var tempValue : string := ""
open : fileStream, loadName, get
get : fileStream, tempValue
layerBoundSize := strint (tempValue)
get : fileStream, tempValue
widthLayer := strint (tempValue)
get : fileStream, tempValue
heightLayer := strint (tempValue)
Resize (widthLayer, heightLayer)
var y : nat := 0
for i : 1 .. layerBoundSize
get : fileStream, tempValue
y := strnat (tempValue)
layer (i).RGB.Alpha := y shr 24
y := y - (round (layer (i).RGB.Alpha) shl 24)
for j : 1 .. 3
layer (i).RGB.CLR (4 - j) := y shr ((3 - j) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (layer (i).RGB.CLR (4 - j) shl ((3 - j) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for %
end for
for i : 1 .. layerBoundSize
layer (i).RGB.Alpha := layer (i).RGB.Alpha / 255
end for
else
Error.Halt ("No file Found")
end if
end Load

procedure Display
var b : array 1 .. sizepic (1, 1, widthLayer, heightLayer) of int
takepic (1, 1, widthLayer, heightLayer, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = round (layer (imageID).RGB.CLR (imageColorShade) * layer (imageID).RGB.Alpha) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for

drawpic (posXLayer, posYLayer, b, 1)
var pic1 : int := Pic.New (posXLayer, posYLayer, posXLayer + widthLayer, posYLayer + heightLayer)
Pic.Draw (pic1, posXLayer, posYLayer, picCopy)
View.Update
Pic.Free (pic1)
end Display

procedure Export (var exportBuffer : array 1 .. * of Pixel)
for i : 1 .. layerBoundSize
exportBuffer (i) := layer (i)
end for
end Export

procedure Clear
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := TransperentColor
layer (i).RGB.CLR (2) := TransperentColor
layer (i).RGB.CLR (3) := TransperentColor
end for
end Clear

procedure SetColor (RedV, GreenV, BlueV : int, AlphaV : real)
setColor.CLR (3) := RedV
setColor.CLR (2) := GreenV
setColor.CLR (1) := BlueV
setColor.Alpha := AlphaV
end SetColor

function ImageSize : int
result widthLayer * heightLayer
end ImageSize

function ImageWidth : int
result widthLayer
end ImageWidth

function ImageHeight : int
result heightLayer
end ImageHeight

procedure Depth (x : int2)
depth := x
end Depth

procedure MergeAlphaLayer
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := round (layer (i).RGB.CLR (1) * layer (i).RGB.Alpha)
layer (i).RGB.CLR (2) := round (layer (i).RGB.CLR (2) * layer (i).RGB.Alpha)
layer (i).RGB.CLR (3) := round (layer (i).RGB.CLR (3) * layer (i).RGB.Alpha)
layer (i).RGB.Alpha := 1
end for
end MergeAlphaLayer

procedure Invert
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := 255 - layer (i).RGB.CLR (1)
layer (i).RGB.CLR (2) := 255 - layer (i).RGB.CLR (2)
layer (i).RGB.CLR (3) := 255 - layer (i).RGB.CLR (3)
end for
end Invert

procedure NoColorAlpha (x : real4)
for i : 1 .. layerBoundSize
if layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3) = (TransperentColor * 3) then
layer (i).RGB.Alpha := x
end if
end for
end NoColorAlpha

procedure ColorBack
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := setColor.CLR (3)
layer (i).RGB.CLR (2) := setColor.CLR (2)
layer (i).RGB.CLR (1) := setColor.CLR (1)
end for
end ColorBack

procedure ColorBackRed
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := setColor.CLR (3)
end for
end ColorBackRed

procedure ColorBackGreen
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (2) := setColor.CLR (2)
end for
end ColorBackGreen

procedure ColorBackBlue
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := setColor.CLR (1)
end for
end ColorBackBlue

procedure AlphaBack
for i : 1 .. layerBoundSize
layer (i).RGB.Alpha := setColor.Alpha
end for
end AlphaBack

procedure BlackWhite
var tempVal : int
for i : 1 .. layerBoundSize
tempVal := (layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3)) div 3
layer (i).RGB.CLR (1) := tempVal
layer (i).RGB.CLR (2) := tempVal
layer (i).RGB.CLR (3) := tempVal
end for
end BlackWhite

procedure FilterColor (percent : real)
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := round ((layer (i).RGB.CLR (3) * (1 - percent)) + (setColor.CLR (3) * percent))
layer (i).RGB.CLR (2) := round ((layer (i).RGB.CLR (2) * (1 - percent)) + (setColor.CLR (2) * percent))
layer (i).RGB.CLR (1) := round ((layer (i).RGB.CLR (1) * (1 - percent)) + (setColor.CLR (1) * percent))
end for
end FilterColor

procedure DrawDot (x, y : int)
if x < widthLayer + 1 and x > 0 and y < heightLayer + 1 and y > 0 then
layer ((y - 1) * widthLayer + x).RGB.CLR (3) := setColor.CLR (3)
layer ((y - 1) * widthLayer + x).RGB.CLR (2) := setColor.CLR (2)
layer ((y - 1) * widthLayer + x).RGB.CLR (1) := setColor.CLR (1)
end if
end DrawDot

procedure DrawOval (x, y, radX, radY : int)
var perimeter : real := 3.1415 * radX * radY
var angleInc : real := 360 / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (angleInc * i)), y + round (radY * sind (angleInc * i)))
end for
end DrawOval

procedure DrawArc (x, y, radX, radY : int, initA, finishA : real)
var perimeter : real := (finishA - initA) / 360 * 3.1415 * radX * radY
var angleInc : real := (finishA - initA) / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (initA + angleInc * i)), y + round (radY * sind (initA + angleInc * i)))
end for
end DrawArc

end Image

module Render
import Image, File, Pixel, PixelValues
export ResizeScreen, Buffer, Update, Clear

const ScreenDepth : int := 0
var screenBuffer : flexible array 1 .. 0 of Pixel
var screenID : int := 0
var screenBound : int := 0
var screenWidth : int := 0
var screenHeight : int := 0
var screenSize : int := 0
var screenScale : real := 0
var backColor : PixelValues
backColor.CLR (1) := 0
backColor.CLR (2) := 0
backColor.CLR (3) := 0
backColor.Alpha := 0

procedure ResizeScreen (width, height : int, scale : real, modes : string)
if screenID not= 0 then
Window.Close (screenID)
end if
screenID := Window.Open ("Graphics:" + intstr (width) + ";" + intstr (height) + "," + modes)
screenWidth := round (width * scale)
screenHeight := round (height * scale)
put screenWidth
screenBound := screenWidth * screenHeight
if screenBound > upper (screenBuffer) then
new screenBuffer, screenBound
end if
screenScale := 1 / scale

end ResizeScreen

procedure Buffer (imagePosX, imagePosY : int, image : pointer to Image)
/*First import the values from the image.*/
var tempBound : array 1 .. image -> ImageSize of Pixel
image -> Export (tempBound)
/*Second take the values and set them based on Depth*/
for x : 1 .. image -> ImageWidth
for y : 1 .. image -> ImageHeight
if (imagePosX + x) > 0 and (imagePosX + x) < screenWidth and (imagePosY + y) > 0 and (imagePosY + y) < screenHeight then
if tempBound (((y - 1) * image -> ImageWidth) + x).Depth > screenBuffer (((y - 1) * screenWidth) + x).Depth then
screenBuffer (((y - 1) * screenWidth) + x).Depth := tempBound (((y - 1) * image -> ImageWidth) + x).Depth

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (1) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (1) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (1) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (2) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (2) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (2) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (3) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (3) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (3) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

%screenBuffer (((y - 1) * screenWidth) + x).RGB.Alpha := 2 / (screenBuffer (((y - 1) * screenWidth) + x).RGB.Alpha + tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha)

else /*if depth is Lesser or equal*/

end if
end if
end for
end for
end Buffer

procedure Update
cls
var b : array 1 .. screenSize of int
takepic (1, 1, screenWidth, screenHeight, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = screenBuffer (imageID).RGB.CLR (imageColorShade) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for
drawpic (1, 1, b, 1)
var pic1 : int := Pic.New (1, 1, 1 + screenWidth, 1 + screenHeight)
var pic2 : int := Pic.Scale (pic1, round (screenWidth * screenScale), round (screenHeight * screenScale))
Pic.Draw (pic2, 1, 1, picCopy)
Window.Update (screenID)
Pic.Free (pic1)
Pic.Free (pic2)
end Update

procedure Clear
for i : 1 .. screenBound
screenBuffer (i).RGB := backColor
screenBuffer (i).Depth := ScreenDepth
end for
end Clear

end Render

procedure ClassTest1
var picture1 : ^Image
new Image, picture1
Render.ResizeScreen (640, 440, 1, "nobuttonbar,offscreenonly,title;Render Test")
picture1 -> Load ("TestSaveFile1")
picture1 -> Invert
picture1 -> Display

Render.Buffer (20, 20, picture1)
Render.Update

end ClassTest1

procedure SaveNewImage (name : string)
var pic1 : int := Pic.FileNew (name)
Pic.Draw (pic1, 1, 1, picCopy)
var imageTemp : ^Image
new Image, imageTemp
imageTemp -> Capture (1, 1, Pic.Width (pic1), Pic.Height (pic1))
imageTemp -> Save ("TestSaveFile1")
Pic.Free (pic1)
end SaveNewImage

SaveNewImage (#"imageName.bmp")
ClassTest1

copthesaint · **Posted:** Wed May 23, 2012 10:59 am

~Bump

I have my whole program working now, I will just remake the whole thing and clean it up. then I will post my first version for turing 4.0.5 that should be bug free.
I have already noticed an issue with speed however I will try to optimise my code while I remake it.

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members